Erreur lors de la copie de données Excel vers PPT en VBA
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 marche sur certains slides et bug 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)
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
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 !
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
'-- 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