Afficher et supprimer des images en VBA avec un menu déroulant

Private Sub Worksheet_Change(ByVal Target As Range)

'///ajout
Dim PIC As Excel.Picture
'///


Application.DisplayAlerts = False
Dim Plage As Range, Intersection As Range
Set Plage = Range("B5:Z5")
Set Intersection = Intersect(Target, Plage)

If Not (Intersection Is Nothing) Then

'-----------------------------------------------------------------

   If Intersection.Value <> "" Then
      For repere = 2 To 100
          If Sheets(2).Cells(4, repere).Value = Intersection.Value Then

'///ajout
For Each PIC In ActiveSheet.Pictures
  If PIC.TopLeftCell.Address = Target.Offset(1, 0).Address Then
    PIC.Delete
    Exit For
  End If
Next PIC
'///

              Sheets(2).Shapes("_" & Target).Copy
              Target.Offset(1, 0).Select
              ActiveSheet.Paste
              Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - Selection.ShapeRange.Width / 2
              Target.Offset(-3, 0) = Sheets(2).Cells(1, repere).Value
              Target.Offset(2, 0) = Sheets(2).Cells(6, repere).Value
     
     'FUSION D'UN MEME TYPE POUR LES CELLULES CONTINGUES
      If Target.Offset(-3, 0) = Target.Offset(-3, -1) Then
          Range("A1:A1") = Target.Offset(-3, 0)
          Range(Target.Offset(-3, 0), Target.Offset(-3, -1)).Merge
      End If
      
      If Target.Offset(-3, 0) = Range("A1:A1") Then
          Range(Target.Offset(-3, 0), Target.Offset(-3, -1)).Merge
      End If
  End If
Next repere
End If
Else
Exit Sub
End If
Range("B5:B5").Activate
Application.DisplayAlerts = True
End Sub