Sub Image()
Dim cel As Range, k1 As Double, k2 As Double
Set cel = [B2] 'à adapter
With ActiveSheet.Shapes("Image 1") 'nom de l'image à adapter
k1 = .Width / cel.Width
k2 = .Height / cel.Height
If k1 > k2 Then
.Width = .Width / k1
.Top = cel.Top + (cel.Height - .Height) / 2
.Left = cel.Left
Else
.Width = .Width / k2
.Top = cel.Top
.Left = cel.Left + (cel.Width - .Width) / 2
End If
End With
End Sub