I found the refined result I came up with...

Sub Pop()
' This pops the image in from the data archive,
'

On Error Resume Next
ActiveSheet.Shapes("Popped").Delete
InsertPicture Range("B6").Value, _
Range("B6:G33"), "Popped"
End Sub

Sub InsertPicture(PictureFileName As String, TargetCells As Range,
picName As String)
' 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
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
'Name the picture so you can delete it later....
p.Name = picName
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub



On Thu, 03 Jan 2013 09:51:12 +0100, "Charlotte E." wrote:

snip long lines (Usenet rules)

Ben

Sub CropIt()
Dim sShape As Shape
Dim sPicture As Shape

Set sShape = Sheet1.Shapes("Rectangle 1")
Set sPicture = Sheet1.Shapes("Picture 4")

With sPicture.PictureFormat 'Reset picture size, then crop to shape size
.CropBottom = 0
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropRight = sPicture.Left + sPicture.Width - sShape.Left - sShape.Width
.CropBottom = sPicture.Top + sPicture.Height - sShape.Top - sShape.Height
.CropLeft = sShape.Left - sPicture.Left
.CropTop = sShape.Top - sPicture.Top
End With

End Sub