Problème pour copier coller une image

Version imprimable

Bonjour,

J'ai un onglet "clients" sur lequel j'ai plusieurs images dans une colonne, chacune sur une ligne (une cellule par image). Ces images sont toutes nommées du nom de l'entreprise correspondant au logo (donc l'image).

Je sélectionne sur un autre onglet dans une cellule via liste déroulante le nom d'une entreprise (onglet "BPU"), pour pouvoir ensuite copier le logo associé (de l'onglet "clients") dans un onglet, pour l'exemple le même onglet que celui ou je sélectionne l'entreprise (donc "BPU").

Malheureusement, aléatoirement j'ai un message de type "la méhode 'paste' de l'objet '_worksheet' a échouée".

J'ouvre alors le debugueur, je clique suivant (la petite fléche lecture), et la macro s'exécute et se termine comme si elle n'avait pas été interrompue. Je dois avouer avoir essayé pas mal de choses mais rien n'y fait (je voulais éviter des select, mais j'ai quand même testé) des pastespecial ect, et j'ai toujours cette erreur aléatoire.

Pour trouver l'image (logo de l'entreprise sélectionnée), je fais une recherche sur la liste d'image "shapes" de mon onglet "client", en comparant le nom de l'entreprise (récupéré dans l'ongler "BPU") et le nom de l'image de la liste shapes de l'onglet "Clients".

C'est toujours la ligne ws.Paste qui est en erreur. J'ai essayé avec un DoEvents, qui j'ai cru avait résolu le problème mais rien n'y fait. J'ai rajouté une destination même si je peux copier n'importe où l'image dans l'absolu vu que je la repositionne et la dimensionne plus tard dans le code.

A noter que je travaille avec en début de macro :
Code:

1 2 Application.ScreenUpdating = False 'désactive le rafraichissement d'écran Application.EnableEvents = False 'désactive les évènements
ws est le nom de ma feuille où je souhaite copier mon image (qui peut varier). Dans le cas présent il s'agit de "BPU".

Si vous avez une idée je suis preneur car moi je sèche. Merci d'avance.
Code:

1 2 3 4 5 6 7 8 9 10 imgname = ws.Cells(9 + decaligne, 6 + decalcol).Value For Each sh In Sheets("clients").Shapes If imgname = sh.Name Then Sheets("Clients").Shapes(imgname).Copy ws.Activate DoEvents ws.Paste Destination:=ws.Range("O1")

Bonsoir, voici une idée à tester:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub CopierLogo()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Dim ws As Worksheet
    Dim imgname As String
    Dim sh As Shape
 
    Set ws = ThisWorkbook.Sheets("BPU")
    imgname = ws.Cells(9 + decaligne, 6 + decalcol).Value
 
    ' Assurez-vous que l'onglet "Clients" est actif
    ThisWorkbook.Sheets("Clients").Activate
 
    ' Recherche de l'image avec le nom imgname
    On Error Resume Next
    Set sh = ThisWorkbook.Sheets("Clients").Shapes(imgname)
    On Error GoTo 0
 
    If Not sh Is Nothing Then
        sh.Copy
        ws.Activate
        ws.Range("O1").Select ' Vous pouvez choisir une cellule de destination appropriée
        ActiveSheet.Paste
    End If
 
    Application.CutCopyMode = False ' Efface le mode de copie
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

22/09/2023, 20h52
methylene67

Bonjour,

Merci de votre réponse rapide, je testerai lundi.

Par contre vous avez mis le nez sur un point, et je suis surpris de ne pas l'avoir vu, pourquoi je test sur chaque image alors qu'ils suffit d'appeler directement mon image, qui a déjà le nom en quetsion, vu que je ne cherche pas à déterminer une ligne ou colonne, carrément plus rapide, plus simple et plus de boucle for.

Bonjour,

Je viens de tester, il me fait toujours la même erreur au même endroit : Activesheet.paste. Mais il faut que je revois la structure générale de mon module, j'ai vu plein de truc qui ne vont pas forcément. Une fois tout repris, j'espère bien ne plus avoir l'erreur.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ThisWorkbook.Sheets("Clients").Activate On Error Resume Next Set sh = ThisWorkbook.Sheets("Clients").Shapes(imgname) On Error GoTo 0 If Not sh Is Nothing Then sh.Copy ws.Activate ws.Range("O1").Select ' Vous pouvez choisir une cellule de destination appropriée ActiveSheet.Paste End If