 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Excel / Programming / January 2006changing size of autoshape
Trying to do some basic animation with an autoshape. I have a rectangle that I am changing the size in steps. The problem is, it resizes the bottom edge of the rectangle up instead of moving the top edge of the rectangle down. here is my code: Code: -------------------- For j = 1 To 200 rectheight = rectheight - 0.5 ActiveSheet.Shapes("Rectangle 1").Height = rectheight For i = 1 To 100 DoEvents Next i Next j -------------------- How do I tell VBA to resize my rectangle from the bottom up?  Signaturegrime ltop = ActiveSheet.shapes("Rectangle 1").Top For j = 1 To 200 rectheight = rectheight - 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 SignatureRegards, Tom Ogilvy > Trying to do some basic animation with an autoshape. I have a rectangle > that I am changing the size in steps. The problem is, it resizes the [quoted text clipped - 15 lines] > > How do I tell VBA to resize my rectangle from the bottom up? My bad. I contradicted myself in my post. As I resize the rectangle, I want the bottom edge to stay in place an have the top edge move. Your code keeps the top edge aligned 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 SignatureRegards, Tom Ogilvy > 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. 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 SignatureRegards, Tom Ogilvy > My mistake in reading. > [quoted text clipped - 18 lines] > http://www.excelforum.com/member.php?action=getinfo&userid=19227 > > View this thread: http://www.excelforum.com/showthread.php?threadid=504923 |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.