Private Sub Worksheet_Change(ByVal Target As Range)
Set images = Sheets("Images")
If Not Intersect([A1:B3], Target) Is Nothing And Target.Count = 1 Then
ligne = Target.Row
'-- suppression
For Each s In ActiveSheet.Shapes
If s.Type = 13 Then If s.TopLeftCell.Address = Cells(ligne, "d").Address Then s.Delete
Next s
If Target <> "" Then
diff = Cells(ligne, "b") - Cells(ligne, "c")
lig = Application.Match(diff, images.Range("différence"), -1) + 1
If Not IsError(lig) Then
col = [différence].Column + 1
For Each s In images.Shapes
If s.TopLeftCell.Address = images.Cells(lig, col).Address Then s.Copy
Next s
End If
Cells(ligne, "d").Select
On Error Resume Next
ActiveSheet.Paste
largeurImage = Selection.ShapeRange.Width
Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - largeurImage / 2
Selection.ShapeRange.Top = ActiveCell.Top + 5
Target.Select
End If
End If
End Sub