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 Sub

J'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 i

Si quelqu'un a une idée de comment faire fonctionner ce code je suis preneur... merci beaucoup.

Rechercher des sujets similaires à "rompre liaisons graphiques ppt"