Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, ecart, n As Byte
Application.ScreenUpdating = False
Me.DrawingObjects.Delete
For Each cel In [B9,D9,F9,I9]
If cel <> "" And cel(3) <> "" Then
ecart = IIf(cel.Column = 9, 2000, 1000)
n = IIf(cel(3) >= cel, 1, IIf(cel - cel(3) <= ecart, 2, 3))
Sheets("Images").DrawingObjects("Image " & n).Copy
Me.Paste
With cel(6)
Selection.Top = .Top + (.Height - Selection.Height) / 2
Selection.Left = .Left + (.Resize(, 2).Width - Selection.Width) / 2
End With
End If
Next
ActiveCell.Activate
[A1].Copy [A1] 'vide le presse-papier
End Sub