Liste déroulante avec image

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 8 And Target.Count = 1 Then
    '-- suppression
    For Each s In ActiveSheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("Images").Shapes(Target).Copy
        Target.Offset(0, 1).Select
        ActiveSheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left + 7
        Selection.ShapeRange.Top = ActiveCell.Top + 5
        Target.Select
     End If
  End If
End Sub

    Selection.ShapeRange.Left = ActiveCell.Left + [SIZE=3][COLOR=red][B]7[/B][/COLOR][/SIZE]

    Selection.ShapeRange.Left = ActiveCell.Left + [SIZE=3][COLOR=blue][B]30[/B][/COLOR][/SIZE]

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