Mise à jour de graphiques dans Powerpoint depuis Excel VBA

**mac4209** · 25/10/2016, 09h58

Bonjour à tous,
J'ai un classeur excel "test" qui contient deux graphiques sur l'onglet "graphiques" : "graphique 1" dont les données sont en A1:B5 de l'onglet "données" et "graphique 2" dont les données sont en E1:F5 sur l'onglet "données". J'ai également un Powerpoint "test" qui contient le graphique 1 en page 2 et le graphique 2 en page 3. Je souhaiterai mettre un Bouton sur mon classeur excel pour mettre à jour le Powerpoint mais je bloque... J'ai utilisé la macro proposé dans la FAQ mais je n'arrive pas à la faire marcher sur mon fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
Sub MAJ_graphiqueDansPresentation()
Dim appPPT As PowerPoint.Application
Dim Sh As PowerPoint.Shape
Dim Gr As Workbook
 
Set appPPT = CreateObject("PowerPoint.Application")
appPPT.Visible = msoTrue
appPPT.Presentations.Open "C:\Users\Administrateur\Desktop\test.pptx"
 
'Copie une plage de cellules dans la feuille active
'Ces données vont être collées dans le classeur incorporé, dans ppt, servant
'de source pour le graphique.
ActiveSheet.Range("A1:B5").Copy
 
'Le classeur incorporé est dans le 1er Slide
With appPPT.ActivePresentation.Slides(2)
    'Boucle sur les formes pour retrouver l'objet Excel
    For Each Sh In .Shapes
        'Verifié s'il s'agit d'un objet incorporé
        If Sh.Type = msoEmbeddedOLEObject Then
            'Vérifie s'il s'agit d'une feuille graphique
            If Sh.OLEFormat.progID = "Excel.Chart.8" Then
                Set Gr = Sh.OLEFormat.Object
                'Colle les données dans la Feuil1 du classeur incorporé
                'La feuil1 contient la source de données pour le graphique
                Gr.Sheets("Données").Range("A1").PasteSpecial
                'réactive la première feuille du classeur incorporé
                '(Le graphique est situé dans ce 1er onglet)
                Gr.Sheets(1).Activate
            End If
        End If
    Next Sh
End With
 
ActiveSheet.Range("E1:F5").Copy
 
'Le classeur incorporé est dans le 1er Slide
With appPPT.ActivePresentation.Slides(3)
    'Boucle sur les formes pour retrouver l'objet Excel
    For Each Sh In .Shapes
        'Verifié s'il s'agit d'un objet incorporé
        If Sh.Type = msoEmbeddedOLEObject Then
            'Vérifie s'il s'agit d'une feuille graphique
            If Sh.OLEFormat.progID = "Excel.Chart.8" Then
                Set Gr = Sh.OLEFormat.Object
                'Colle les données dans la Feuil1 du classeur incorporé
                'La feuil1 contient la source de données pour le graphique
                Gr.Sheets("Données").Range("E1").PasteSpecial
                'réactive la première feuille du classeur incorporé
                '(Le graphique est situé dans ce 1er onglet)
                Gr.Sheets(1).Activate
            End If
        End If
    Next Sh
End With
End Sub

Quelqu'un pourrait-il m'aider ?
Merci par avance

**halaster08** · 25/10/2016, 10h36

Pas le temps de regarder ton code en détail mais voici le code que j'utilise pour mettre à jour un powerpoint.

Dans le fichier Excel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Sub ppt()
If Month(Date) = 1 Then
    annee = Year(Date) - 1
    mois = 12
Else
    annee = Year(Date)
    mois = Month(Date) - 1
End If
If mois < 10 Then
    t = "0"
Else
    t = ""
End If
 
    Dim ppapp As Object
    Dim Pres As Presentation
' on ouvre le fichier powerpoint
    Set ppapp = CreateObject("PowerPoint.Application")
    ppapp.Visible = True
    Set Pres = ppapp.Presentations.Open(Range("chemin_ppt") & Range("nom_ppt"))
'on lance la macro de de mise à jour des liens
    Pres.Application.Run Range("nom_ppt") & "!MaJ_lien"
'on sauvegarde
    Pres.Save
'on copie sans macro à l'emplacement indiqué dans la sheet("TO DO")
    Pres.SaveAs Range("chemin_exp") & "_" & t & mois & "_" & annee, ppSaveAsOpenXMLPresentation
 
End Sub

Dans le Power point:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Public Sub MaJ_lien()
Dim objPres As Presentation
Dim objSld As Slide
Dim objShp As Shape
Dim strAncien As String
Dim strNouveau As String
 
 
    Set objPres = ActivePresentation
 
    ' parcourt des diapositives de la présentation
    For Each objSld In objPres.Slides
        ' parcourt des formes des diapositives
        For Each objShp In objSld.Shapes
            ' on test si c'est un objet lié
            If objShp.Type = msoLinkedOLEObject Then
                'on met à jour les liens
                objShp.LinkFormat.Update
            End If
        Next objShp
    Next objSld
 
End Sub

PS:

J'ai utilisé la macro proposé dans la FAQ mais je n'arrive pas à le faire marché sur mon fichier.

Sans plus de détail, tu auras peu de réponse.
Un message d'erreur? si oui lequel et a quel ligne

**mac4209** · 25/10/2016, 11h44

Envoyé par halaster08

PS:

Sans plus de détail, tu auras peu de réponse.
Un message d'erreur? si oui lequel et a quel ligne

Je n'ai pas de message d'erreur, mais il ne se passe rien.
Merci pour le code, je vais essayer de l'appliquer à mon fichier.

**halaster08** · 25/10/2016, 11h53

En regardant un peu plus ton code, je vois que tu fais des copier coller, que je ne fais pas du tout.
As tu coller tes graphiques avec le collage spécial par liaison?

**mac4209** · 26/10/2016, 10h51

J'ai coller en incorporant le classeur, d'où les copier coller en plus je pense... Après je débute sur VBA donc pour faire mon code j'ai juste pris le code que j'ai trouvé et j'ai essayé de l'adapter à mon cas ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
' on ouvre le fichier powerpoint
    Set ppapp = CreateObject("PowerPoint.Application")
    ppapp.Visible = True
    Set Pres = ppapp.Presentations.Open(Range("chemin_ppt") & Range("nom_ppt"))

Je suis en train de tester ton code, mais j'ai un problème au niveau de l'ouverture du fichier. Le chemin de mon fichier complet est "C:\Users\Administrateur\Desktop\test.pptm"

Que mets-tu dans "chemin_ppt" et dans "nom_ppt" exactement ?

**halaster08** · 26/10/2016, 11h30

Chemin: C:\Users\Administrateur\Desktop\
Nom: test.pptm
Ces deux infos étant remplie des cellules que je nomme. Ce qui permet a quelqu'un qui ne connait pas VBA de changer le chemin et/ou le nom du fichier sans avoir a modifier la macro. Je sépare en deux car pour appeler la macro j'ai besoin du nom uniquement

Mais tu peux ecrire directement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set Pres = ppapp.Presentations.Open("C:\Users\Administrateur\Desktop\test.pptm")

et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Pres.Application.Run "test.pptm!MaJ_lien"

Par contre j'insiste sur le fait que mon code marche pour un collage special avec liaison
Nom : Untitled.jpg
Affichages : 3093
Taille : 95,6 Ko

Je ne sais pas ce que tu entends par "coller en incorporant le classeur" mais le problème vient peut être de là

**mac4209** · 26/10/2016, 14h12

Merci beaucoup pour tes explications. J'ai réussi à ouvrir le powerpoint depuis Excel et je pense que la macro Excel marche. Par contre, j'ai un souci pour la macro powerpoint... Je l'ai copier coller tel que tu l'a écrite, fallait-il modifier quelque chose ?
La macro tourne sans mettre d'erreur mais rien ne se met à jour. J'ai modifier mon powerpoint pour coller mes graphique avec liaison et je peux les mettre à jour en faisant "outils - création - actualiser les données". Je pense que c'est ce que fait la macro mais dans mon fichier, elle ne fonctionne pas...

**halaster08** · 26/10/2016, 14h29

Normalement il n'y a rien a modifer, elle marche tel quel chez moi, et c'est l'équivalent de "clic droit" (sur un graphe) "update link".

Essaye ceci et dis moi la valeur que tu obtient.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Public Sub MaJ_lien()
Dim objPres As Presentation
Dim objSld As Slide
Dim objShp As Shape
Dim strAncien As String
Dim strNouveau As String
dim c as integer
c=0 
    Set objPres = ActivePresentation
 
    ' parcourt des diapositives de la présentation
    For Each objSld In objPres.Slides
        ' parcourt des formes des diapositives
        For Each objShp In objSld.Shapes
            ' on test si c'est un objet lié
            If objShp.Type = msoLinkedOLEObject Then
                c=c+1
                'on met à jour les liens
                objShp.LinkFormat.Update
            End If
        Next objShp
    Next objSld
msgbox c 
End Sub

**mac4209** · 26/10/2016, 14h33

J’obtiens 0. Ca veut donc dire que powerpoint ne reconnait pas mes graphiques ?

**mac4209** · 26/10/2016, 14h41

Toutes mes excuses, c'est en effet les graphiques qui étaient mal collés pour que ta macro marche. Je pensais pourtant qu'en faisant clic droit et coller en liant les données c'était pareil que coller le lien comme tu as mis plus haut... A priori non !

Merci beaucoup pour ton aide et le temps que tu as pris pour moi, je mets le problème comme résolu.

**pyro34** · 30/08/2017, 18h12

Bonjour,

J'ai repris le code généreusement fourni par halaster08,
Malheureusement je n'arrive pas à compiler, je tombe sur l'erreur suivante :

"/ ! \ erreur de compilation : Type défini par l'utilisateur non défini "

la ligne de code concerné est la suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Pres As Presentation

Quelqu'un voit-il mon erreur ? ou une piste pour m'aider ?

**halaster08** · 31/08/2017, 07h40

Bonjour,

Deux options: soit tu actives les références ppt (je sais plus où ça se fait exactement mais en cherchant sur le net tu trouveras)
soit tu fais du late binding, en en remplaçant la ligne par dim pres as objectPerso je préfére le late binding, vu mon code il a l'air de dater de la période transition vu qu'il y en a mais pas complètement.
Si tu veux plus d'info il y a un tuto sur le late/early binding, j'ai pas le lien sous la main mais en cherchant un peu tu peux le retrouver.

**pyro34** · 31/08/2017, 11h32

Bonjour,

Merci beaucoup pour ta réponse rapide, j'ai regardé les 2 options qui m'ont aidé :

soit tu actives les références ppt

Dans l'éditeur de macros :>Menu Outils => Références => Cochez la ligne "Microsoft Powerpoint x.x Object Library". =>Cliquez sur OK pour valider.
https://excel.developpez.com/faq/?pa...jGraphExcelPPT

soit tu fais du late binding, en en remplaçant la ligne par dim pres as object

J'ai essayé aussi cette option mais pour un débutant le concept n'est pas simple a comprendre
http://mhubiche.developpez.com/vba/f...endre/binding/

Les 2 solutions m'ont permis d'avancer mais maintenant je bloque à la dernier ligne
Erreur d'execution '1004': la méthode 'range de l'objet'_global' a échoué

En fait je ne comprends pas cette ligne donc je ne sais pas comment la modifier et son but (et la présence de la date)

J'ai essayé ces 2 options mais sans succès, avez vous une idée ?

Pres.SaveAs Range("chemin_exp") & "_" & t & mois & "_" & annee, ppSaveAsOpenXMLPresentation

Et en reprenant l'exemple de chemin de dossier plus haut ce code (j'ai modifié le chemin pour mon cas bien entendu)
Pres.SaveAs ("C:\Users\Administrateur\Desktop\test.pptm") & "_" & t & mois & "_" & annee, ppSaveAsOpenXMLPresentation

**halaster08** · 31/08/2017, 12h35

Pour le late binding, en gros au lieu de lui dire directement c'est une présentation powerpoint (qui nécessite d'activer la référence), tu lui c'est un objet, et ensuite que l'objet est une présentation powerpoint, au final tu as la même chose mais sans avoir besoin d'activer les références.

La dernière ligne me sert a sauver la présentation dans un autre répertoire avec la date (dans le nom du fichier) et sans les macro. Le fichier xlsm n'est disponible que pour moi c'est pour être sur que personne ne vienne mettre le bordel dedans, ensuite j'en fait une copie sur un répertoire partagé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Pres.SaveAs "C:\Users\Administrateur\Desktop\test" & "_" & t & mois & "_" & annee &".pptm" , ppSaveAsOpenXMLPresentation

Mise à jour de graphiques dans Powerpoint depuis Excel VBA [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager