Rompre liaisons graphiques Excel dans PPT
Bonjour à tous.
Je souhaite réaliser une macro dans laquelle des graphiques générés sur Excel sont collés sur des slides PPT sans liaison.
Je souhaite en effet que les liaisons avec la source soient supprimées pour que mes graphiques collés sur PPT ne changent pas si les données et les graphiques sur excel sont modifiés (ce qui sera souvent le cas pendant que je manipulerai le PPT).
Je parviens à coller les graphiques sur les slides sans problème, mais pas moyen de rompre la liaison avec la source. J'ai essayé le code suivant, et d'autres dans le même style trouvés sur des forums, mais tous sans succès :
Sub export_ppt()
'Activation exportation Excel vers PPT
Dim PptApp As PowerPoint.Application
Dim Pptdoc As PowerPoint.Presentation
Dim Shpe As Object
Dim NbShpe As Integer
Dim Sld As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Set PptApp = CreateObject("PowerPoint.Application") 'création session PowerPoint
Set Pptdoc = PptApp.Presentations.Open("C:\Users\...\Desktop\TEST BREAKLINKS.pptx") 'ouverture fichier PPT
With Pptdoc
'SLIDE 1
'Graphique "Objectif"
Sheets("nombre d'actions").ChartObjects("Objectif - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(1).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(1).Shapes.Count
With Pptdoc.Slides(1).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 80 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'Graphique "Cadre"
Sheets("nombre d'actions").ChartObjects("CadreAction - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(1).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(1).Shapes.Count
With Pptdoc.Slides(1).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 240 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'Graphique "Provenance"
Sheets("nombre d'actions").ChartObjects("Provenance - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(1).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(1).Shapes.Count
With Pptdoc.Slides(1).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 400 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'SLIDE 2
'Graphique "Objectif"
Sheets("nombre d'actions").ChartObjects("Objectif - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(2).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(2).Shapes.Count
With Pptdoc.Slides(2).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 80 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'Graphique "Cadre"
Sheets("nombre d'actions").ChartObjects("CadreAction - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(2).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(2).Shapes.Count
With Pptdoc.Slides(2).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 240 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'Graphique "Provenance"
Sheets("nombre d'actions").ChartObjects("Provenance - global").Activate
ActiveChart.ChartArea.Copy 'copie le graphique Excel
Pptdoc.Slides(2).Shapes.Paste 'colle le graphique sur PPT
NbShpe = Pptdoc.Slides(2).Shapes.Count
With Pptdoc.Slides(2).Shapes(NbShpe)
.Left = 2 'position horizontale du geaphique dans la slide
.Top = 400 'position verticale dans la slide
.Height = 150 'hauteur du graphique
.Width = 250 'largeur du graphique
End With
'Supprimer les liaisons des graphiques
For Each Sld In Presentation.Slides
For Each Sh In Sld.Shapes
If Sh.Type = msoLinkedOLEObject Then
If Sh.OLEFormat.progID = "excel.sheet" Then
Sh.LinkFormat.BreakLink
End If
End If
Next
Next
End With
End SubJ'ai peut être un problème dans la déclaration de mes variables, ou un autre soucis que je n'arrive pas à identifier... Je vous joins le fichier excel avec la macro ainsi que les slides PPT sur lesquelles les graphiques doivent être collés, si besoin.
Pour info :
- sur ma feuille excel, les graphiques sont modifiés automatiquement à partir des données entrées dans les colonnes de gauche
- ne pas oublier de modifier la ligne Set Pptdoc = PptApp.Presentations.Open("C:\Users\...\Desktop\TEST BREAKLINKS.pptx") selon votre dossier de destination si vous souhaitez tester le code
Je vous remercie par avance de votre aide.
J'ai également testé le code suivant pour rompre la liaison mais ça ne fonctionne pas non plus :
Dim Links As Variant
Dim i As Long
Links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
For i = 1 To UBound(Links)
ActiveWorkbook.BreakLink _
Name:=Links(i), _
Type:=xlLinkTypeExcelLinks
Next iSi quelqu'un a une idée de comment faire fonctionner ce code je suis preneur... merci beaucoup.