Problème de copie VBA

Bonjour j'aimerais savoir pk la copie de mes images ne fonctionnne pas. J'ai essayer d'éviter l'utilisation de pastespecial car cela crée des problèmes sur l'environnement de certain utilisateur. merci encore d'avance de votre réponse

Public Sub Afficher_pdg()
    Dim image_antillopole As Shape
    Dim image_reseau As Shape
    Dim images_inge As Shape
    Dim image_ville As Shape
    Dim ligne_insertion_image As Range

    Dim copie_image_reseau As Shape
    Dim copie_image_inge As Shape
    Dim copie_image_ville As Shape
    Dim copie_image_antillopole As Shape

      Dim case_image_antillopole As Range
    Set case_image_antillopole = feuille_devis.Range("B4")

       On Error Resume Next
    Set image_antillopole = feuille_image.Shapes("image_antillopole")
    On Error GoTo 0

    If Not image_antillopole Is Nothing Then
        ' Copier l'image dans le presse-papiers
        image_antillopole.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

        ' Coller l'image à la cellule de destination
        case_image_antillopole.Paste

        On Error Resume Next
        Set copie_image_antillopole = feuille_devis.Shapes("copie_image_antillopole")
        On Error GoTo 0

        If copie_image_antillopole Is Nothing Then
            Set copie_image_antillopole = feuille_devis.Shapes(feuille_devis.Shapes.Count)
        End If

        ' Ajuster la hauteur et la largeur aux nouvelles proportions
        With copie_image_antillopole
            .LockAspectRatio = msoTrue
            ' Nommer la copie
            .Name = "copie_image_antillopole"
        End With
    End If

    copie_image_antillopole.Top = case_image_antillopole.Top
    copie_image_antillopole.Left = case_image_antillopole.Left + 222

    'image reseau
    '---------------------------------------------------------------------

  ' Référence à la ligne d'insertion
Set ligne_insertion_image = feuille_devis.Range("societe_nom_pdg").Offset(4, -1).Resize(, 5)

' Référence à la cellule de destination pour "image_reseau"
Dim case_image_reseau As Range
Set case_image_reseau = ligne_insertion_image.Cells(1, 1)

' Vérifier si la Shape nommée "image_reseau" existe déjà
On Error Resume Next
Set image_reseau = feuille_image.Shapes("image_reseau")
On Error GoTo 0

' Copier l'image "image_reseau" si elle existe
If Not image_reseau Is Nothing Then
    image_reseau.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ' Coller l'image à la cellule active
    feuille_devis.Paste feuille_devis.Range("A1")

    ' Référence à la copie dans feuille_devis par son nom
    On Error Resume Next
    Set copie_image_reseau = feuille_devis.Shapes("copie_image_reseau")
    On Error GoTo 0

    ' Si la copie n'existe pas, utilisez le dernier ajout
    If copie_image_reseau Is Nothing Then
        Set copie_image_reseau = feuille_devis.Shapes(feuille_devis.Shapes.Count)
    End If

    ' Ajuster la hauteur et la largeur aux nouvelles proportions
    With copie_image_reseau
        .LockAspectRatio = msoTrue
        ' Nommer la copie
        .Name = "copie_image_reseau"
    End With

    ' Positionner l'image à l'emplacement souhaité
    copie_image_reseau.Top = case_image_reseau.Top
    copie_image_reseau.Left = case_image_reseau.Left + 120
End If

    'IMAGE INGE ---------------------------------------------------------------------------------------------

   ' Référence à la cellule de destination pour "images_inge"
Dim case_images_inge As Range
Set case_images_inge = ligne_insertion_image.Cells(1, 2)

' Vérifier si la Shape nommée "images_inge" existe déjà
On Error Resume Next
Set images_inge = feuille_image.Shapes("image_inge")
On Error GoTo 0

' Copier l'image "images_inge" si elle existe
If Not images_inge Is Nothing Then
    images_inge.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ' Coller l'image à la cellule active
    feuille_devis.Paste feuille_devis.Range("A1")

    ' Référence à la copie dans feuille_devis par son nom
    On Error Resume Next
    Set copie_image_inge = feuille_devis.Shapes("copie_image_inge")
    On Error GoTo 0

    ' Si la copie n'existe pas, utilisez le dernier ajout
    If copie_image_inge Is Nothing Then
        Set copie_image_inge = feuille_devis.Shapes(feuille_devis.Shapes.Count)
    End If

    ' Ajuster la hauteur et la largeur aux nouvelles proportions
    With copie_image_inge
        .LockAspectRatio = msoTrue
        ' Nommer la copie
        .Name = "copie_image_inge"
    End With

    ' Positionner l'image à l'emplacement souhaité
    copie_image_inge.Top = copie_image_reseau.Top
    copie_image_inge.Left = copie_image_reseau.Left + copie_image_reseau.Width + 50
End If

    ' IMAGE VILLE CONNECTER --------------------------------------

   ' Référence à la cellule de destination pour "image_ville"
Dim case_image_ville As Range
Set case_image_ville = ligne_insertion_image.Cells(1, 3)

' Vérifier si la Shape nommée "image_ville" existe déjà
On Error Resume Next
Set image_ville = feuille_image.Shapes("image_ville")
On Error GoTo 0

' Copier l'image "image_ville" si elle existe
If Not image_ville Is Nothing Then
    image_ville.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ' Coller l'image à la cellule active
    feuille_devis.Paste

    ' Référence à la copie dans feuille_devis par son nom
    On Error Resume Next
    Set copie_image_ville = feuille_devis.Shapes("copie_image_ville")
    On Error GoTo 0

    ' Si la copie n'existe pas, utilisez le dernier ajout
    If copie_image_ville Is Nothing Then
        Set copie_image_ville = feuille_devis.Shapes(feuille_devis.Shapes.Count)
    End If

    ' Ajuster la hauteur et la largeur aux nouvelles proportions
    With copie_image_ville
        .LockAspectRatio = msoTrue
        ' Nommer la copie
        .Name = "copie_image_ville"
    End With

    ' Positionner l'image à l'emplacement souhaité
    copie_image_ville.Top = copie_image_inge.Top
    copie_image_ville.Left = copie_image_inge.Left + copie_image_inge.Width + 50
End If

End Sub

bonjour debutant vba,

sans fichier, c'est difficile de vous aider, mais copier & coller un image entre plusieurs feuilles est assez sensibles au temps. Cela veut dire qu'il faut freiner le processus à certaines places avec des "Doevents" ou avec une gestion des erreurs. Je vois que vous faitez déjà quelque chose parreil, mais si cela suffit ???

Merci beaucoup de ta réponse BsAlv.

Malheuresment je reçoit l'erreur 1004 au niveau du paste. Je ne peux pas transmettre le fichier étant donnée qu'il contien des données sensible. J'avais une autre idée qui consistait a "hide" les imagesur ma feuille devis et à les faire réapparaître à la bonne postion. Mais cela me pose plusieurs problème car j'aimerais avoir un feuille me servant de "base de donnée" image afin d'éviter toute erreur lors de la manipulation par des users.

re,

Difficile pour vous aider comme ca.

une solution bric-à-brac pour freiner l'exécution : chaque fois que vous avez un problème comme ça, vous ajoutez quelque "DoEvents" devant la ligne qui cause ce problème, comme dans le code ici dessous. Si cela ne suffit pas avec 5 DoEvents, ajoutez une ligne supplémentaire pour en avoir 10 ou 15.

     If Not image_antillopole Is Nothing Then
          ' Copier l'image dans le presse-papiers
          image_antillopole.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
          DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
          ' Coller l'image à la cellule de destination
          case_image_antillopole.Paste
         DoEvents: DoEvents: DoEvents: DoEvents: DoEvents

          On Error Resume Next

2eme solution, mettez "application.screenupdating=false" au début (après vos "Dims") de la macro et "Application.screenupdating=true" à la fin (avant End Sub), pour bloquer l'écran pendant l'exécution.

Merci beaucoup de ta reponse. Au final j'ai opté pour la méthode que j'avais proposé dans ma première réponse car même avec tes ajustements je rencontre le même problème. Encore merci d'avoir pris le temps de m'aider

re,

succès ...