Sub InsertionImage()
Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim Rep As Integer
Dim Image As Integer

Image = 1
lig = 3
colon = 2

'Boucle pour supprimer l'ancienne image

For Each ShapeObj In ActiveSheet.Shapes
If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
Next ShapeObj
line1:
If Application.Dialogs(xlDialogInsertPicture).Show Then
'Définit l'emplacement de l'image

Set Emplacement = Range(Cells(lig, colon), Cells(lig + 6, colon + 1)) 'Range("D" & Image * 3 & ":E" & Image * 3 + 2)

Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

With Img.ShapeRange
'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
.Name = "Cible" & Image
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With

Else
MsgBox "Insertion d'image interrompue."
End If


Rep = MsgBox("Voulez-vous continuez ?", vbYesNo + vbQuestion, "Encore une image")
If Rep = vbYes Then
Image = Image + 1

If Image Mod 7 <> 0 Then lig = lig
If Image Mod 7 <> 0 Then colon = colon + 3

If Image Mod 7 = 0 Then lig = lig + 9
If Image Mod 7 = 0 Then colon = 2


GoTo line1:
Else
' ici le traitement si réponse négative
' ...
End If

End Sub