Position shapes to be centered in a cell

[James]

Hi, Ive got a question about how to re-position a shape (type 13).

Ive got a spreadsheet that has a bunch of little pictures nested each in its
own cell. what im trying to do is center the picture in the center of the
cell. Im getting an error on "selection.shaperange.incrementtop 10" what am i
doing wrong?

any help would be great, thanks in advance

For Each C In Activesheet.Range("E11:BF100")
C.Select
On Error Resume Next 'if no shape in that cell
Selection.ShapeRange.IncrementTop 10
Selection.ShapeRange.IncrementLeft -1
On Error GoTo 0
Next C

 

[Dave Peterson]

Centering the pictures in a cell doesn't mean too much to me.

You could have the picture fill up the cell with no border--or have a large
border and a very small picture--or anything in between.

When I'm doing this kind of thing, I usually want the picture to fill the cell
(and not go outside the cell). That means I can shrink the height and width
(preservinging the aspect ratio, too).

Either way, this may give you a way to experiment with what you want:

Option Explicit
Sub testme()
Dim myPict As Picture
Dim myCell As Range
Dim myRngToInspect As Range
Dim myAspectRatio As Double

With ActiveSheet
Set myRngToInspect = .Range("E11:E20") 'E11:BF100 after finished testing

For Each myPict In .Pictures
Set myCell = myPict.TopLeftCell
If Intersect(myCell, myRngToInspect) Is Nothing Then
'outside that range, skip it
Else
With myPict
myAspectRatio = .Width / .Height
.ShapeRange.LockAspectRatio = msoTrue

.Left = myCell.Left
.Top = myCell.Top
.Height = myCell.Height
.Width = myAspectRatio * .Height
If .Width > myCell.Width Then
'too wide for the cell
'With the aspectratio locked, the
'reducing the width will reduce the height
.Width = myCell.Width
End If
End With
End If
Next myPict
End With

End Sub

 

[James]

Thank you for the help. p45cal that method worked great. I do have 2003 and
probably the reason for the error. thanks again!