Private Sub Worksheet_Change(ByVal Target As Range)
Stop ' pour test appuyer sur f8 pour pas à pas
If Target.Column = 8 And Target.Count = 1 Then
'-- suppression image existante dans la cellule
For Each s In ActiveSheet.Shapes ' parcours de toutes images de la feuille
If s.Type <> 8 Then ' on ne prend pas les zones de texte
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Delete
End If
End If
Next s
'--
If Target <> "" Then
lig = [liste].Find(Target, LookAt:=xlWhole).Row 'recherche du code choisi dans la liste
col = [liste].Column + 1
témoin = False ' y a t-il une image pour ce code ?
For Each s In Sheets("Images").Shapes ' parcours de toutes les images
If s.TopLeftCell.Address = Cells(lig, col).Address Then
largeurImage = s.Width
témoin = True ' on a trouvé une image pour le code
s.Copy ' on copie l'image
End If
Next s
If témoin Then
Target.Offset(0, 1).Select
ActiveSheet.Paste ' collage presse papier
Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - largeurImage / 2
Selection.ShapeRange.Top = ActiveCell.Top + 5
Target.Select
End If
End If
End If
End Sub