whoops, should be incrementing the top

ltop = ActiveSheet.shapes("Rectangle 1").Top
For j = 1 To 200
rectheight = rectheight - 0.5
ltop = ltop + 0.5
Application.ScreenUpdating = False
ActiveSheet.Shapes("Rectangle 1").Height = rectheight
Activesheet.Shapes("Rectangle 1").Top = lTop
Application.ScreenUpdating = True
For i = 1 To 100
DoEvents
Next i
Next j

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
My mistake in reading.

ltop = ActiveSheet.shapes("Rectangle 1").Top
For j = 1 To 200
rectheight = rectheight - 0.5
ltop = ltop - 0.5
Application.ScreenUpdating = False
ActiveSheet.Shapes("Rectangle 1").Height = rectheight
Activesheet.Shapes("Rectangle 1").Top = lTop
Application.ScreenUpdating = True
For i = 1 To 100
DoEvents
Next i
Next j

--
Regards,
Tom Ogilvy


"grime" wrote in
message
...

My bad. I contradicted myself in my post.

As I resize the rectangle, I want the bottom edge to stay in place and
have the top edge move. Your code keeps the top edge aligned.


--
grime
------------------------------------------------------------------------
grime's Profile:
http://www.excelforum.com/member.php...o&userid=19227
View this thread:
http://www.excelforum.com/showthread...hreadid=504923