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


I found this a long time ago, and it scales a picture to fit within the
range I declare, AFAICT.

It was a while ago, so my familiarity with its workings is not current.

I am sure that you could find the pieces which will give your code the
effect you desire.


To quote (attributes not related to me in any way):

» Insert pictures using VBA in Microsoft Excel

VBA macro tip contributed by Erlandsen Data Consulting offering Microsoft
Excel Application development, template customization, support and
training solutions

CATEGORY: General Topics in VBA

VERSIONS: All Microsoft Excel Versions

With the macro below you can insert pictures at any range in a worksheet.
The picture can be centered horizontally and/or vertically.

Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", _
Range("D10"), True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
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)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub

With the macro below you can insert pictures and fit them to any range in
a worksheet.

Sub TestInsertPictureInRange()
InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' 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)
' 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

In case anyone else is interested.

Thank you for your help, and the need for VB qualification.
This gives the terms "Visual Basic" a whole new meaning... or not. :-]