Bonjour,

Voici un code me permettant de réaliser, par le biais de mon classeur Excel, une macro qui m'ouvre un PPT existant et ensuite me copie/colle des données à des endroits précis sur mon PPT.

Ce code a été testé sur XLSM 2013 est fonctionne parfaitement mais dès que je veux le faire fonctionner sur du XLSM 2010, ça bug à la ligne 53 en me disant que l'objet n'existe pas. Ce soit disant objet est juste un tableau Excel avec des données et non un graphique.

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Sub RMD_M43()
 
    'Message de création PPT RMD
Select Case MsgBox("Création du Powerpoint concernant la prochaine RMD. Elle sera enregistrée avec le nom du mois en cours. Désirez-vous créer ce PPT ?", vbYesNo, "Application développée par C.")
   Case vbYes
 
    'procédure si click sur Oui
Dim WSAccueil As Worksheet
Set WSAccueil = Sheets("Accueil")
Dim ppt As PowerPoint.Application      ' Application PowerPoint
Dim Pres As PowerPoint.Presentation    ' Presentation
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True ' Indispensable, sinon il ne peut pas ouvrir de fichier (Erreur)
 
   ' On lui dit de quelle présentation il s'agit et la présentation reste masquée:
Set Pres = ppt.Presentations.Open(Filename:="E:\RMD M43.pptm") ', WithWindow:=msoFalse
 
With Pres
.Slides.Add Index:=2, Layout:=ppLayoutBlank
.Slides.Add Index:=3, Layout:=ppLayoutBlank
 
End With
 
   'Deprotection page Acceuil
Sheets("Accueil").Unprotect
 
   'Dégroupe Graphique suivi referentiel documentaire
Sheets("Accueil").Shapes("Groupe 10").Ungroup
 
    'Copie le graphique du suivi documentaire
Sheets("Accueil").ChartObjects("Graphique 8").Copy
With Sheets("Accueil").Shapes.Range(Array("graphique 8", "Connecteur droit 6"))
    .Group
    .Name = "Groupe 10"
End With
 
    'Collage special en image du graphique suivi documentaire
Pres.Slides(2).Shapes.PasteSpecial ppPasteJPG
 
' on met en forme le graphique suivi documentaire
  With Pres.Slides(2).Shapes(1)
.Name = "GrapheDoc" 'personnaliser le nom de l'image insérée
.Left = 80 'position horizontale dans le slide
.Top = 60 'position verticale dans le slide
.Height = 150 'hauteur image
.Width = 600 'largeur image
End With
 
    ' Zone de la feuille Excel "tableau du % referentiel a jour par processus" à copier
Sheets("Accueil").Range("r5:ac20").Copy
 
    'Coller les cellules Excel "tableau du % referentiel a jour par processus" dans Powerpoint diapo 2
Pres.Slides(2).Shapes.Paste
 
' on met en forme le Tableau de % de màj du référentiel documentaire
  With Pres.Slides(2).Shapes(2)
.Name = "TableauDoc" 'personnaliser le nom de l'image insérée
.Left = 80 'position horizontale dans le slide
.Top = 305 'position verticale dans le slide
.Height = 100 'hauteur image
'.Width = 300 'largeur image
End With
 
    ' Zone de la feuille Excel "Audits" à copier
Sheets("Accueil").Range("C34:F42").Copy
 
    'Coller les cellules Excel "Audits" dans Powerpoint diapo 3
Pres.Slides(3).Shapes.Paste
 
' on met en forme le Tableau des audits
With Pres.Slides(3).Shapes(1)
.Name = "TableauAudit" 'personnaliser le nom de l'image insérée
.Left = 20 'position horizontale dans le slide
.Top = 170 'position verticale dans le slide
.Height = 50 'hauteur image
.Width = 280 'largeur image
End With
 
    ' Zone de la feuille Excel "Graphe Audits" à copier
    Dim graphique As Chart
Set graphique = Sheets("Accueil").ChartObjects(1).Chart
graphique.ChartArea.Copy
   Pres.Slides(3).Shapes.Paste
 
' on met en forme le graphe des audits
With Pres.Slides(3).Shapes(2)
.Name = "GrapheAudit" 'personnaliser le nom de l'image insérée
.Left = 20 'position horizontale dans le slide
.Top = 30 'position verticale dans le slide
.Height = 140 'hauteur image
.Width = 300 'largeur image
End With
 
    ' Zone de la feuille Excel "Fiches de progrès" à copier
Sheets("Accueil").Range("i23:o44").Copy
 
    'Coller les cellules Excel "Fiches de progrès" dans Powerpoint diapo 3
Pres.Slides(3).Shapes.Paste
 
    ' on met en forme le tableau Fiches de progres
With Pres.Slides(3).Shapes(3)
.Name = "TableauFP" 'personnaliser le nom de l'image insérée
.Left = 300 'position horizontale dans le slide
.Top = 95 'position verticale dans le slide
.Height = 140 'hauteur image
.Width = 300 'largeur image
End With
 
    ' Zone de la feuille Excel "Plan d'actions amélioration processus" à copier
Sheets("Accueil").Range("q23:ai44").Copy
 
    'Coller les cellules Excel "Plan d'actions amélioration processus" dans Powerpoint diapo 3
Pres.Slides(3).Shapes.Paste
 
 ' on met en forme le tableau plan actions amélioration processus
With Pres.Slides(3).Shapes(4)
.Name = "TableauPlanAction" 'personnaliser le nom de l'image insérée
.Left = 10 'position horizontale dans le slide
.Top = 296 'position verticale dans le slide
.Height = 200 'hauteur image
.Width = 700 'largeur image
End With
 
    'On sauvegarde sous le nom de la presentation + le mois en cours
Dim nom As String
nom = Left(Pres.Name, Len(Pres.Name) - 5) & " - " & Format(Date, "MMMM YYYY") & ".pptm"
Pres.SaveCopyAs "E:\" & nom
 
' Et on quitte PowerPoint proprement :
Pres.Close
ppt.Quit
'Set ppt = Nothing
 
rep = MsgBox("Une sauvegarde a été transmise vers E:\, sous le nom suivant : " & nom, vbYes + vbInformation, "Sauvegarde PPT RMD ...")
 
 
    ' Protection page Accueil
Sheets("Accueil").Select
Sheets("Accueil").Protect
 
MsgBox "Création de votre PPT concernant la prochaine R.M.D effectuée."
 
Case vbNo
 
    'procédure si click sur Non
MsgBox "Opération abandonnée."
 
End Select
 
End Sub
Cordialement,
Graphikris.

Voici le msg exact lors de l'arret de ma macro :
Pièce jointe 202656