Discussion :

[methylene67]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Franc]

Bonsoir, voici une idée à tester:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

[methylene67]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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