View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default Can You Reset a shape's Left & Top position

Hi again Jason,

After some testing I now see what you mean. Joel's comment that the shape
rotates on its axis is correct and while the shape appears to have altered
its left and top positon, reading the values shows them as unchanged and
therefore resetting them to the old values does nothing. The following code
uses maths to relocate a rectangle shape. Firstly makes it a square then
rotates and then returns it to a rectangle and resets the left position.

I haven't gone into it to the nth degree and so it only works with rotation
from zero to 90 degrees. however, it might point you in the right direction
to achieve what you want.

To test the code, create a rectangle shape from the drawing toolbar on the
active sheet. (Ensure that it is Rectangle 1).

Sub RotateRectangleShape()
'NOTE: Not all variables required in test
'Left for future reference only

'Code only works for rotation from zero to 90 degrees
'Will require Case statement and test for current
'rotation position and adjust maths to cope
'with rotation from/to other positions.

Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHt As Double
Dim dblRot As Double
Dim shp As Shape

Set shp = ActiveSheet.Shapes("Rectangle 1")

With shp
dblLeft = .Left
dblTop = .Top
dblWidth = .Width
dblHt = .Height
dblRot = .Rotation

'Make rectangle into square
.Height = dblWidth

'Rotate
.IncrementRotation 90

'Return to rectangle
.Height = dblHt

'Reset left coordinate
.Left = dblLeft - (dblWidth - dblHt) / 2

End With

End Sub



Just for interest I used the following code to test what occurs when a
rectangle shape is rotated. As for the previous code create a Rectangle shape
on the active sheet.

Sub ShapeRotationTest()

Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHt As Double
Dim dblRot As Double
Dim shp As Shape

Set shp = ActiveSheet.Shapes("Rectangle 1")

With shp
dblLeft = .Left
dblTop = .Top
dblWidth = .Width
dblHt = .Height
dblRot = .Rotation

MsgBox "Left = " & dblLeft & vbCrLf & _
"Top = " & dblTop & vbCrLf & _
"Width = " & dblWidth & vbCrLf & _
"Height = " & dblHt & vbCrLf & _
"Rotation = " & dblRot

.IncrementRotation 90

'.Left = dblLeft 'does nothing
'.Top = dblTop 'does nothing

MsgBox "Left = " & .Left & vbCrLf & _
"Top = " & .Top & vbCrLf & _
"Width = " & .Width & vbCrLf & _
"Height = " & .Height & vbCrLf & _
"Rotation = " & .Rotation

End With

End Sub


--
Regards,

OssieMac