Private Sub Worksheet_Change(ByVal Target As Range)
Dim ratio#, W#, H#
If Target.Column = 5 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
Set cible = Target.Offset(0, 1)
Sheets("Ardt").Shapes("Paris " & Target).Copy
cible.PasteSpecial
With Selection 'il s'agit de l'image qui vient d'être collée
.ShapeRange.LockAspectRatio = msoTrue ' lock leratio indéformable
ratio = .Width / .Height ' calcul ratio
W = cible.Width ' width range
H = cible.Height ' height range
If (W / H < ratio) Then
.Width = W - 2 'en redimentionant le width le height se redimentionne automatiquement
Else 'ou
.Height = H - (2 / ratio) 'en redimentionant le height le width se redimentionne automatiquement
End If
.Left = cible.Left + ((cible.Width - .Width) / 2) + 1
.Top = cible.Top + ((cible.Height - .Height) / 2)
.Placement = 1
End With
Target.Select
End If
End If
End Sub