Sub InsertPicture()
'J Walkenbach, mpep
Dim MyCell As Range
Dim MyPicture As Picture
Dim image$, dl&, i&
dl=cells(rows.count,1).end(xlup).row
On Error GoTo fin
For i=2 to dl
image = Range("a" & dl)
Set MyCell = Range("b" & dl)
MyCell.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MyCell.Height
.Width = MyCell.Width
End With
MyCell.Select
Next i
'Range("c2") = MyCell.Height & " x " & MyCell.Width
Exit Sub
fin:
MsgBox " Il y a une erreur de saisie dans la cellule A2 . ", vbInformation, "Message "
End Sub