Hi all

I have an issue with a .Paste instruction that will regularly launch an error on some Mac platforms.


The subroutine where the error occur is
RemplacerMarqueurspartableau
The instruction that strikes an error is
Set Targetshape = pptSlide.Shapes.Paste
After a long time, typical error is that clipboard contains unappropriate data

I have tried several variations (CommandBars.ExecuteMSO "Paste" for example) but with no stable success (program will run fine sometimes on some MAC systems but not on the target system)
What is noticable is that code will function correctly for all range objects and wil only bug for graphics...


Thanks for any help !!

Full code follows

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
                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