Sub coller2()
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
'If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
'If Dir(PictureFileName) = '' Then Exit Sub
' import picture
'p = ActiveSheet.Pictures.Insert("Image1")
' determine positions
'Stop
[image1].Copy
ActiveCell.Select
ActiveSheet.Paste
With ActiveCell
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With Selection
.Top = t + 4
.Left = l + 4
.Width = w - 8
.Height = h - 8
End With
Set p = Nothing
SendKeys ("{ESC}")
End Sub