Position shapes to be centered in a cell
 

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

Position shapes to be centered in a cell
 

Maybe you have Excel 2007 and it allows you to select shapes on a sheet
in this way (Selection.ShapeRange (ie. a range of cells on a sheet
doesn't have its own range of shapes)). Not in Excel 2003.
A sheet has its collection of shapes, and you can define your own
shaperange to contain what shapes you like - you could even use each
shape's TopLeftCell and BottomRightCell properties to help you decide
which shapes to include.
The following bit of code puts the centre of each shape on the active
sheet on the centre of its TopLeftCell (a process which could well
change the TopLeftCell property of the shape, especially if the shape is
bigger than that cell):Sub blah()
For Each shp In ActiveSheet.Shapes
Set xxx = shp.TopLeftCell
shp.Top = xxx.Top + xxx.Height / 2 - shp.Height / 2
shp.Left = xxx.Left + xxx.Width / 2 - shp.Width / 2
Next shp
End Sub
and a way, perhaps, of narrowing down just which shapes you
want to move around:Sub blah()
For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, Range("E11:BF100")) Is Nothing
Then
Set xxx = shp.TopLeftCell
shp.Top = xxx.Top + xxx.Height / 2 - shp.Height / 2
shp.Left = xxx.Left + xxx.Width / 2 - shp.Width / 2
End If
Next shp
End Sub


--
p45cal

*p45cal*
------------------------------------------------------------------------
p45cal's Profile: http://www.thecodecage.com/forumz/member.php?userid=558
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=134999

Position shapes to be centered in a cell
 

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 wrote:

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

Position shapes to be centered in a cell
 

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

"p45cal" wrote:


Maybe you have Excel 2007 and it allows you to select shapes on a sheet
in this way (Selection.ShapeRange (ie. a range of cells on a sheet
doesn't have its own range of shapes)). Not in Excel 2003.
A sheet has its collection of shapes, and you can define your own
shaperange to contain what shapes you like - you could even use each
shape's TopLeftCell and BottomRightCell properties to help you decide
which shapes to include.
The following bit of code puts the centre of each shape on the active
sheet on the centre of its TopLeftCell (a process which could well
change the TopLeftCell property of the shape, especially if the shape is
bigger than that cell):Sub blah()
For Each shp In ActiveSheet.Shapes
Set xxx = shp.TopLeftCell
shp.Top = xxx.Top + xxx.Height / 2 - shp.Height / 2
shp.Left = xxx.Left + xxx.Width / 2 - shp.Width / 2
Next shp
End Sub
and a way, perhaps, of narrowing down just which shapes you
want to move around:Sub blah()
For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, Range("E11:BF100")) Is Nothing
Then
Set xxx = shp.TopLeftCell
shp.Top = xxx.Top + xxx.Height / 2 - shp.Height / 2
shp.Left = xxx.Left + xxx.Width / 2 - shp.Width / 2
End If
Next shp
End Sub


--
p45cal

*p45cal*
------------------------------------------------------------------------
p45cal's Profile: http://www.thecodecage.com/forumz/member.php?userid=558
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=134999