Difficulté sous mac avec une instruction .Paste

[Toto41]

Bonjour,
J'ai un souci avec une automation Excel vers Powerpoint au moment de coller un graphique dans une présentation.
Le programme fonctionne sans souci pour les objets range, et de toute façon j'opte pour un .CopyPicture donc je suis étonné que le type de source génère un comportement différent, je pensais que .CopyPicture aller charger un objet du même type dans le presse papier, mais force est de constater que sur certaines plateforme mac (pas toutes) le code ne fonctionne pas
Mon erreur se trouve dans la macro

RemplacerMarqueurspartableau

à l'instruction

Set Targetshape = pptSlide.Shapes.Paste

L'erreur typique est que l'on ne peut copier car le presse papier contient des données invalides, cette erreur intervient après un temps d'attente relativement long, et Err.num = 0 donc je vois juste que targetshape is nothing

J'ai essayé différentes variantes, par exemple pptSlide.Commandbars.ExecuteMSO "Paste" ce qui fonctionne ou pas selon les plateformes mais continue donc de buguer. Egalement de copier une première fois en image le graphique internement à Excel pour ensuite copier l'image vers PPT ... mais je patauge encore
Voici l'intégralité du code de la routine

Public pptApp As Object
Public pptPresentation As Object
Sub getap()

'------------------   INITIALISATION  -------------------
Set wspilot = ThisWorkbook.Sheets("Transco") 'ThisWorkbook.targetws
wspilot.Range("Etat_prog").Interior.Color = RGB(255, 214, 153)
wspilot.Range("Etat_prog").Value = "Exportation en cours"
Application.Wait (Now + TimeValue("0:00:01"))
    DoEvents
Application.ScreenUpdating = False
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'----------   GESTION ERREUR PRESENTATION  -------
If pptApp Is Nothing Then
wspilot.Range("Etat_prog") = "Ouvrir PowerPoint"
Application.ScreenUpdating = True
MsgBox "PowerPoint n'est pas ouvert"
Exit Sub
End If

Dim wbcible As Workbook
On Error Resume Next
Set wbcible = Workbooks(wspilot.Range("classeur3TP").Value)
On Error GoTo 0
'----------   GESTION ERREUR CLASSEUR SOURCE -------
If wbcible Is Nothing Then
wspilot.Range("Etat_prog") = "Classeur source non trouve"
wspilot.Range("Etat_prog").Interior.Color = RGB(219, 179, 217)

Application.ScreenUpdating = True
MsgBox "Le classeur source ne semble pas ouvert"
Exit Sub
End If

Set pptPresentation = pptApp.ActivePresentation

'!!!!!!!!!!!!!!!!!!!!!!!    DEBUT BOUCLE BALISE   !!!!!!!!!!!!!!!!!!!!!!!
numbalise = 1
While wspilot.Range("Balise").Offset(numbalise, 0) <> "" 'ici on boucle sur les balises

wspilot.Range("etatexport").Offset(numbalise, 0) = ""
If wspilot.Range("export").Offset(numbalise, 0) = 1 Then 'on v_rifie si l'utilisateur a demande l'exportation de la donnee

'------------------   GESTION CLASSEUR SOURCE  ------------------
If wspilot.Range("sourcebis").Offset(numbalise, 0).Value <> "" Then
Set sourcecible = Nothing
On Error Resume Next
Set sourcecible = Workbooks(wspilot.Range("sourcebis").Offset(numbalise, 0).Value)
On Error GoTo 0
'----------   GESTION ERREUR SOURCE SECONDAIRE  -------
If sourcecible Is Nothing Then
wspilot.Range("Etat_prog") = "Classeur secondaire non trouve"
wspilot.Range("Etat_prog").Interior.Color = RGB(219, 179, 217)
Application.ScreenUpdating = True
wspilot.Range("sourcebis").Offset(numbalise, 0).Select
MsgBox "Le classeur " & wspilot.Range("sourcebis").Offset(numbalise, 0).Value & " ne semble pas ouvert"
Exit Sub
End If
Else
Set sourcecible = wbcible
End If

manature = wspilot.Range("Nature").Offset(numbalise, 0).Value
mononglet = wspilot.Range("Onglet").Offset(numbalise, 0).Value
monpointeur = wspilot.Range("Pointeur").Offset(numbalise, 0).Value
monpointeur2 = wspilot.Range("Pointeur").Offset(numbalise, 1).Value

monetat = wspilot.Range("Etat").Offset(numbalise, 0)
If manature = "Chaine de caractere" Then
Call RemplacerMarqueurs(wspilot.Range("Balise").Offset(numbalise, 0), wspilot.Range("valformat").Offset(numbalise, 0), wspilot.Range("etatexport").Offset(numbalise, 0), wspilot.Range("remplacetous").Offset(numbalise, 0))
Else
                sourcecible.Activate
sourcecible.Sheets(mononglet).Select
lebonpointeur = ""
If monetat = "Le pointeur principal a ete trouve" Then
                    lebonpointeur = monpointeur
ElseIf monetat = "Le pointeur secondaire a ete trouve" Then
                    lebonpointeur = monpointeur2
End If

If lebonpointeur <> "" And manature = "Tableau" Then

Call RemplacerMarqueurspartableau(wspilot.Range("Balise").Offset(numbalise, 0), sourcecible.Sheets(mononglet).Range(lebonpointeur), wspilot.Range("Left").Offset(numbalise, 0), wspilot.Range("Top").Offset(numbalise, 0), wspilot.Range("height").Offset(numbalise, 0), wspilot.Range("width").Offset(numbalise, 0), wspilot.Range("deletebalise").Offset(numbalise, 0), manature, wspilot.Range("etatexport").Offset(numbalise, 0), wspilot.Range("remplacetous").Offset(numbalise, 0))
If wspilot.Range("export0") Then wspilot.Range("export").Offset(numbalise, 0) = 0
ElseIf lebonpointeur <> "" And manature = "Graphique" Then
Call RemplacerMarqueurspartableau(wspilot.Range("Balise").Offset(numbalise, 0), sourcecible.Sheets(mononglet).ChartObjects(lebonpointeur), wspilot.Range("Left").Offset(numbalise, 0), wspilot.Range("Top").Offset(numbalise, 0), wspilot.Range("height").Offset(numbalise, 0), wspilot.Range("width").Offset(numbalise, 0), wspilot.Range("deletebalise").Offset(numbalise, 0), manature, wspilot.Range("etatexport").Offset(numbalise, 0), wspilot.Range("remplacetous").Offset(numbalise, 0))
If wspilot.Range("export0") Then wspilot.Range("export").Offset(numbalise, 0) = 0
Else
wspilot.Range("etatexport").Offset(numbalise, 0) = "La cible n'est pas pointee correctement"
wspilot.Range("etatexport").Offset(numbalise, 0).Interior.Color = RGB(255, 218, 185)
End If
                ThisWorkbook.Activate
End If
Else
wspilot.Range("etatexport").Offset(numbalise, 0) = "Export desactive pour la cible"
wspilot.Range("etatexport").Offset(numbalise, 0).Interior.Color = RGB(230, 230, 250)

End If
numbalise = numbalise + 1
Wend

    pptApp.Activate
Set pptPresentation = Nothing
Set pptApp = Nothing
Application.ScreenUpdating = True
wspilot.Range("Etat_prog") = "Exportation terminee"
Range("Etat_prog").Interior.Color = RGB(135, 206, 235)
Debug.Print "export termine avec succes"

End Sub
Sub RemplacerMarqueurs(balise, replacementText, etatexport, remplacer) 'cette fonction remplace toutes les occurences de la balise
Dim pptSlide As Object
' Remplacer les balises sur chaque diapositive
nbexport = 0
For Each pptSlide In pptPresentation.Slides
For Each myshapes In pptSlide.Shapes
trouvtext = ""
On Error Resume Next
trouvtext = InStr(1, myshapes.TextFrame.TextRange.Text, balise)
On Error GoTo 0
If Not (trouvtext = "" Or trouvtext = 0) Then
myshapes.TextFrame.TextRange.Characters(trouvtext, Len(balise)) = replacementText
nbexport = nbexport + 1
If remplacer = 1 Then GoTo sortirdetoutes
End If
Next myshapes
Next pptSlide
sortirdetoutes:
If nbexport > 0 Then
etatexport.Value = "La cible a ete exportee " & nbexport & " fois"
etatexport.Interior.Color = 15917529
Else
etatexport.Value = "La balise ne semble pas avoir ete trouvee"
etatexport.Interior.Color = RGB(255, 218, 185)
End If
End Sub
Sub RemplacerMarqueurspartableau(balise, replacementTab, myleft, mytop, myheight, mywidth, deletebalise, manature, etatexport, remplacer) 'cette fonction ne remplace qu'une seul occurence
Dim pptSlide As Object
Dim targetshape As Object
Set clipboardData = Nothing
nbexport = 0
For Each pptSlide In pptPresentation.Slides 'parcourir les slides
For Each myshapes In pptSlide.Shapes 'parcourir les diff_rents shapes
trouvtext = ""
On Error Resume Next
trouvtext = InStr(1, myshapes.TextFrame.TextRange.Text, balise) 'recherche de la balise
On Error GoTo 0
If Not (trouvtext = "" Or trouvtext = 0) Then 'test si la balise a _t_ trouv_e

If manature = "Graphique" Then
replacementTab.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
                DoEvents
Application.Wait (Now + TimeValue("0:00:04"))

Err.Clear
On Error Resume Next
Set targetshape = pptSlide.Shapes.Paste 'erreur à cette instruction
On Error GoTo 0

If targetshape Is Nothing Or Err.Number <> 0 Then
etatexport.Value = "Erreur d'exportation"
etatexport.Interior.Color = RGB(250, 128, 114)
Err.Clear
GoTo sortieerreur
End If

Else
replacementTab.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set targetshape = pptSlide.Shapes.Paste
End If

With targetshape
                    .LockAspectRatio = msoTrue
If myleft <> "" Then .Left = myleft
If mytop <> "" Then .Top = mytop
If myheight <> "" Then .Height = myheight
If mywidth <> "" Then .Width = mywidth
End With
If deletebalise = 1 Then myshapes.Delete
nbexport = nbexport + 1
If remplacer = 1 Then GoTo sortirdetoutes
End If
Next myshapes
Next pptSlide
sortirdetoutes:
If nbexport > 0 Then
etatexport.Value = "La cible a ete exportee " & nbexport & " fois"
etatexport.Interior.Color = 15917529
Else
etatexport.Value = "La balise ne semble pas avoir ete trouvee"
etatexport.Interior.Color = RGB(255, 218, 185)
End If
sortieerreur:
End Sub