Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, I As Long, Ligne As Variant, Img As Object
If Target.Address <> "$B$2" Then Exit Sub
Application.ScreenUpdating = False
For I = ActiveSheet.DrawingObjects.Count To 1 Step -1
If UCase(ActiveSheet.DrawingObjects(I).Name) <> "LOGO" Then
ActiveSheet.DrawingObjects(I).Delete
End If
Next I
For Each C In Range("A7", Cells(Rows.Count, 1).End(xlUp))
Application.EnableEvents = False
With Sheets("Photo")
For I = 1 To .DrawingObjects.Count
Ligne = Application.Match(C.Value, .[A:A], 0)
If IsNumeric(Ligne) Then
If .DrawingObjects(I).TopLeftCell.Address = .Cells(Ligne, 2).Address Then
' .DrawingObjects(I).TopLeftCell.Copy C.Offset(, 4)
Set Img = .DrawingObjects(I)
Img.Copy
C.Offset(, 4).Select
ActiveSheet.Paste
Set Img = Selection
Img.Top = C.Top + (C.Height - Img.Height) / 2
Img.Left = C.Offset(, 4).Left + (C.Offset(, 4).Width - Img.Width) / 2
Exit For
End If
End If
Next I
End With
Application.EnableEvents = True
Next C
Application.ScreenUpdating = True
End Sub