Sub InsertionImage()
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object
On Error GoTo fin:
For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image
If ShapeObj.Name = "cible" Then ActiveSheet.Shapes("cible").Delete
Next ShapeObj
Set Emplacement = Range("D3:E8")
Set image = ActiveSheet.Pictures.Paste
With image.ShapeRange
.Name = "cible" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite )
.LockAspectRatio = msoTrue
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
End With
Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub