Sub InsererImage()
Dim fichier As Variant, s As Shape, x, y, w, h
fichier = Application.GetOpenFilename
If fichier = False Then Exit Sub
ActiveCell.Activate 'au cas où un objet serait sélectionné
Application.ScreenUpdating = False
For Each s In ActiveSheet.Shapes
If Not Intersect(Selection, s.TopLeftCell) Is Nothing Then s.Delete
Next
x = Selection.Left: y = Selection.Top: w = Selection.Width: h = Selection.Height
With ActiveSheet.Shapes.AddPicture(fichier, True, True, x, y, -1, -1)
.LockAspectRatio = msoTrue 'conserve les proportions de l'image d'origine
.Width = w
If .Height < h Then
.Top = y + (h - .Height) / 2
Else
.Height = h
.Left = x + (w - .Width) / 2
End If
End With
End Sub