Discussion :

[Jp_66]

Bonjour à tous,

Je viens vers vous car je rencontre un problème lors de la copie (image) de données d'un classeur Excel vers Powerpoint avec VBA.

Le message d'erreur que je rencontre lors de l'exécution de la macro est le suivant :
Erreur d'exécution -2147188160 (80048240):Shapes(unknown member) : Invalid request. The specified data type is Unavailable


Je copie plusieurs tableaux dans plusieurs slides Powerpoint, et ce, sur plusieurs fichiers. Parfois la macro fonctionne, parfois non.
Pour un même fichier Powerpoint, elle peut marcher sur certains slides et buger sur d'autres.


J'ai regardé un peu sur Internet, j'ai essayé des solutions proposées mais sans succès :
- vider le presse papiers avant chaque copier/coller (appel de la macro Commande0_Click)
- insérer en début de code : "Application.CutCopyMode = False"


Pouvez-vous m'aider SVP ?


Je vous transmets mon code :
Mes bugs apparaissent au moment de coller dans les slides PPT (PptDoc.Slides(...).Shapes.PasteSpecial DataType:=2)

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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
 
Sub export_ppt(Nom_Sortie_PDF, sp)
 
Dim PPT As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim NbShpe As Byte
Dim wb As Workbook
 
Application.CutCopyMode = False
 
Set wb = ActiveWorkbook
 
Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint
PPT.Visible = True
 
Set PptDoc = PPT.Presentations.Open(Filename:="\\W\0 - test new maquette\CR_PPT.pptx") 'ouverture fichier ppt
 
'Page de garde
PptDoc.Slides(1).Shapes(4).TextFrame.TextRange.Text = wb.Sheets("Page de garde").Range("C14").Value
 
'Démo
Call Commande0_Click
 
wb.Sheets("Démo").Range("B2:Q28").Copy
 
PptDoc.Slides(4).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(4).Shapes.Count
 
With PptDoc.Slides(4).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 2.64 * 28.35
.Top = 2.85 * 28.35
.Height = 13.36 * 28.35
.Width = 28.59 * 28.35
End With
 
'Démo (2)
Call Commande0_Click
 
wb.Sheets("Démo (2)").Range("B2:Q28").Copy
 
PptDoc.Slides(5).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(5).Shapes.Count
 
With PptDoc.Slides(5).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 4 * 28.35
.Top = 2.9 * 28.35
.Height = 13.24 * 28.35
.Width = 25.86 * 28.35
End With
 
'Résultats
Call Commande0_Click
 
wb.Sheets("Résultats").Range("B3:Q41").Copy
 
PptDoc.Slides(7).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(7).Shapes.Count
 
With PptDoc.Slides(7).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 2.25 * 28.35
.Top = 2.55 * 28.35
.Height = 14.29 * 28.35
.Width = 28.68 * 28.35
End With
 
'Conso 1
Call Commande0_Click
 
wb.Sheets("Conso 1").Range("B3:W44").Copy
 
PptDoc.Slides(10).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(10).Shapes.Count
 
With PptDoc.Slides(10).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 1.54 * 28.35
.Top = 3.85 * 28.35
.Height = 11.35 * 28.35
.Width = 30.79 * 28.35
End With
 
'Conso 2
Call Commande0_Click
 
wb.Sheets("Conso 2").Range("B2:P34").Copy
 
PptDoc.Slides(11).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(11).Shapes.Count
 
With PptDoc.Slides(11).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 3.9 * 28.35
.Top = 3.19 * 28.35
.Height = 13.4 * 28.35
.Width = 22.91 * 28.35
End With
 
'Conso3
Call Commande0_Click
 
If sp > 1 Then
 
    wb.Sheets("Conso 3").Range("B2:AA43").Copy
 
    PptDoc.Slides(12).Shapes.PasteSpecial DataType:=2
 
    NbShpe = PptDoc.Slides(12).Shapes.Count
 
    With PptDoc.Slides(12).Shapes(NbShpe)
    .LockAspectRatio = msoFalse
    .Left = 1.54 * 28.35
    .Top = 4.45 * 28.35
    .Height = 10.16 * 28.35
    .Width = 30.79 * 28.35
    End With
 
Else
    Call Commande0_Click
 
    wb.Sheets("Conso 3 bis").Range("B2:T43").Copy
 
    PptDoc.Slides(12).Shapes.PasteSpecial DataType:=2
 
    NbShpe = PptDoc.Slides(12).Shapes.Count
 
    With PptDoc.Slides(12).Shapes(NbShpe)
    .LockAspectRatio = msoFalse
    .Left = 1.54 * 28.35
    .Top = 4.45 * 28.35
    .Height = 10.16 * 28.35
    .Width = 30.79 * 28.35
    End With
 
End If
 
'Conso4
Call Commande0_Click
 
Sheets("Conso 4").ChartObjects("Graphique 4").CopyPicture xlPrinter, xlPicture
 
PptDoc.Slides(13).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(13).Shapes.Count
 
With PptDoc.Slides(13).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 2.94 * 28.35
.Top = 2.68 * 28.35
.Height = 12.49 * 28.35
.Width = 27.99 * 28.35
End With
 
'RAC
Call Commande0_Click
 
wb.Sheets("RAC").Range("B2:Q40").Copy
 
PptDoc.Slides(15).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(15).Shapes.Count
 
With PptDoc.Slides(15).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 4.21 * 28.35
.Top = 2.58 * 28.35
.Height = 14.04 * 28.35
.Width = 25.45 * 28.35
End With
 
'Tx de consommants
Call Commande0_Click
 
wb.Sheets("Tx de consommants").Range("B2:S43").Copy
 
PptDoc.Slides(17).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(17).Shapes.Count
 
With PptDoc.Slides(17).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 0.81 * 28.35
.Top = 3.1 * 28.35
.Height = 12.81 * 28.35
.Width = 32.11 * 28.35
End With
 
'Tx de consommants (2)
Call Commande0_Click
 
wb.Sheets("Tx de consommants (2)").Range("B2:S43").Copy
 
PptDoc.Slides(18).Shapes.PasteSpecial DataType:=2
 
NbShpe = PptDoc.Slides(18).Shapes.Count
 
With PptDoc.Slides(18).Shapes(NbShpe)
.LockAspectRatio = msoFalse
.Left = 0.81 * 28.35
.Top = 3.1 * 28.35
.Height = 12.81 * 28.35
.Width = 32.11 * 28.35
End With
 
PptDoc.ExportAsFixedFormat Nom_Sortie_PDF, 2
 
PptDoc.Close
 
End Sub

Merci d'avance pour votre aide !
A bientôt

[Jp_66]

J'ai trouvé la solution, je la poste ici, si cela peut aider des utilisateurs.

En gros, la méthode est la suivante :
- je vide le presse papiers (fonction Commande0_Click)
- je sélectionne l'onglet XL où j'ai mes données
- je copie mes données
- je fais une boucle qui fait patienter le système jusqu'à que le presse-papiers soit rempli (test avec isclipboardempty)
- quand c'est good, je colle sur mon slide

Et là, plus de bug !

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
 
Call Commande0_Click
 
wb.Sheets("Tx de consommants (2)").Select
ActiveWindow.Zoom = 50
 
wb.Sheets("Tx de consommants (2)").Range("B2:S43").Copy
 
For i = 1 To 100
    If isClipboardEmpty() Then
          Application.Wait Now() + #12:00:02 AM#
    End If
Next i
 
PptDoc.Slides(18).Select
 
PptDoc.Slides(18).Shapes.PasteSpecial DataType:=2

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
 
'-- Déclaration des fonctions API
Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long
 
Sub Commande0_Click()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub
 
 
Public Function isClipboardEmpty() As Boolean
    OpenClipboard 0&
 
    isClipboardEmpty = (CountClipboardFormats() = 0)
 
    CloseClipboard
End Function

Bye !