Erreur lors de la copie de données Excel vers PPT en VBA

Le 24/06/2021 à 11:37

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

Le 25/06/2021 à 09:53

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

Rechercher des sujets similaires à "erreur lors copie donnees ppt vba"