Répéter une macro Excel sur plusieurs colonnes

Bonjour à ous,

je souhaite répéter une macro excel sur plusieurs colonnes. Cette macro me permet de récupérer une image en fonction d'une référence et de centrer l'image sur une cellule.

La macro est la suivante (celle-ci fonctionne):

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B1")) Is Nothing Then

répertoire = ThisWorkbook.Path

On Error Resume Next

ActiveSheet.Shapes("monimageB").Delete

Set img = ActiveSheet.Pictures.Insert(répertoire & "\Images plans Sandvik\" & Range("B1") & ".PNG")

img.Name = "monimageB"

img.Left = [B3].Left + ([B3].Width / 2) - (img.Width / 2)

img.Top = [B3].Top + ([B3].Height / 2) - (img.Height / 2)

End If

End Sub

J'ai testé la solution suivante pour balayer les colonnes mais celle-ci ne fonctionne pas:

Private Sub Worksheet_Change(ByVal Target As Range)

For c = 2 To 100

If Not Intersect(Target, Range("Cells(1, c")) Is Nothing Then

répertoire = ThisWorkbook.Path

On Error Resume Next

ActiveSheet.Shapes("monimage c").Delete

Set img = ActiveSheet.Pictures.Insert(répertoire & "\Images plans Sandvik\ " & Range(Cells(1, c)) & ".PNG")

img.Name = "monimage c"

img.Left = Cells(3, c).Left

img.Top = Cells(3, c).Top

End If

Next

End Sub

Auriez-vous une solution pour m'éviter de copier/modifier ce code pour X colonnes?

D'avance merci.

Cordialement,

Mike07

Bonjour et bienvenue sur le forum

Cette instruction est incorrecte :

If Not Intersect(Target, Range("Cells(1, c")) Is Nothing Then

Essaie avec celle-ci :

If Not Intersect(Target, Cells(3, c)) Is Nothing Then

Bye !

Bonjour et merci pour ta réponse,

j'ai corrigé cette erreur mais la macro ne fonctionne toujours pas. Je voulais te mettre les 2 fichiers en pièce jointe mais sans les images (dans le bon dossier) qui vont avec cela ne sert a rien...

Bonjour, il y a aussi ici à modifier

Set img = ActiveSheet.Pictures.Insert(répertoire & "\Images plans Sandvik\ " & Range(Cells(1, c)) & ".PNG")

Ensuite si un jour vous devenez mécanicien automobile j'aimerai bien vous apporter ma voiture et vous dire : "bonjour ça ne marche pas".

A bon entendeur

Re-bonjour,

je comprends que ma demande n'est pas très claire... j'ai du mal à l'expliquer. En faite sur le premier exemple je répète une formule et change systématiquement le code pour pouvoir parcourir les colonnes B-->C-->D.... Comme il faut faire pour plus de 150 colonnes j'ai essayé de faire une boucle afin de répéter la formule avec une variable qui correspond au numéro de colonne.

Je vous met en pièce jointe un zip qui permettra peu-être de mieux comprendre mon explication. Ce zip contient les 2 essais:

• "Gestion" qui est concluant mais qui est "lourd" puisqu'il faut réécrire les formules
• "Gestion copie" qui ne fonctionne pas

D'avance merci.

P.S: j'ai modifier les 2 points énoncés

Mike07 a écrit :

j'ai corrigé cette erreur mais la macro ne fonctionne toujours pas.

Alors, pourquoi ne pas essayer de mettre ton code dans un module, plutôt que dans une macro événementielle ?

Cela donnerait :

Sub essai()
    For c = 2 To 100
        répertoire = ThisWorkbook.Path
        On Error Resume Next
        ActiveSheet.Shapes("monimage c").Delete
        Set img = ActiveSheet.Pictures.Insert(répertoire & "\Images plans Sandvik\ " & Cells(1, c) & ".PNG")
        img.Name = "monimage c"
        img.Left = Cells(3, c).Left
        img.Top = Cells(3, c).Top
    Next
End Sub

Bye !

Cette solution ne fonctionne pas non plus