Drawing in Excel – 2

Before getting down to basics, the attached file:

Animation demo

Illustrates how Excel shapes can be simply animated.

Screen shot:
Animation demo

The code for the animation (having previously drawn a circle and a rectangle with no fill, and noted their names):

Sub Animate()
Dim Start As Single, xInc As Single, yInc As Single, OvlWidth As Single, OvlHeight As Single
Dim OvlX As Single, OvlY As Single
Dim TopBox As Single, BottBox As Single, LeftBox As Single, RightBox As Single
Dim Pi As Double, TimeStep As Double, XV As Double, YV As Double
Pi = Atn(1) * 4

XV = Range("hspeed").Value
YV = Range("vspeed").Value

TimeStep = 0.01

With ActiveSheet.Shapes("oval 2")
OvlWidth = .Width
OvlHeight = .Height
End With

With ActiveSheet.Shapes("rectangle 14")
TopBox = .Top + OvlHeight / 2
BottBox = TopBox + .Height - OvlHeight
LeftBox = .Left + OvlWidth / 2
RightBox = LeftBox + .Width - OvlWidth
End With

xInc = XV * (RightBox - LeftBox) / 1000
yInc = YV * (BottBox - TopBox) / 1000

With ActiveSheet.Shapes("oval 2")
Do
.IncrementLeft xInc
.IncrementTop yInc
Start = Timer
Do While Timer < Start + TimeStep
DoEvents
Loop
OvlX = .Left + OvlWidth / 2
OvlY = .Top + OvlHeight / 2
If OvlX &LT LeftBox Or OvlX &GT RightBox Then xInc = -xInc
If OvlY &LT TopBox Or OvlY &GT BottBox Then yInc = -yInc
Loop
End With
End Sub

Where &LT and &GT indicate the “Less Than” and “Greater Than” symbols respectively.

 

 

 

Advertisements
This entry was posted in Drawing, Excel, Newton and tagged , , , , . Bookmark the permalink.

17 Responses to Drawing in Excel – 2

  1. That’s very cool.

    Like

  2. jonpeltier says:

    These animations are fun.

    You know, you can give your shapes unique names of your own choosing. Select the shape, click in the Name Box, enter a name, and click Enter.

    Like

  3. dougaj4 says:

    New and improved file now available for download.

    Now with two colliding balls!

    I haven’t got the collisions quite right, but it’s still fairly hypnotic to watch!

    Like

    • sara says:

      Can any one help please..??? friend
      Let me attach the CODE BELOW
      Option Explicit
      Public RunWhen As Double
      Sub StartBlink()
      If Sheet3.Range(”L7″).Interior.ColorIndex = 3 Then
      Sheet3.Range(”L7″).Interior.ColorIndex = 6
      Else
      Sheet3.Range(”L7″).Interior.ColorIndex = 3
      End If
      RunWhen = Now + TimeSerial(0, 0, 1)
      Application.OnTime RunWhen, “StartBlink”, , True
      End Sub
      Sub StopBlink()
      Sheet3.Range(”L7″).Interior.ColorIndex = xlAutomatic
      Application.OnTime RunWhen, “StartBlink”, , False
      End Sub
      This codes for Blinking the cell..,its working perfect
      So if some condition is met,i have called STARTBLINK same way
      if other conditon is met ..,i have called stopblink.
      Now my problem.., this codes for sheet3 only..,so
      now when i move on to next sheets,while having the CELLS BLINK in sheet3
      its showimg some ERROR MESSAGE
      runtime error 1004
      UNABLE TO SET THE COLOUR INDEXPROPERTY OF THE INTERIOR CLASS
      so can any one please help me how to avoid this..?

      Like

  4. Pingback: Drawing in Excel-3 « Newton Excel Bach, not (just) an Excel Blog

  5. Pingback: Newton’s Cradle « Newton Excel Bach, not (just) an Excel Blog

  6. Pingback: Drawing in Excel « Golbing

  7. saravana says:

    Hi..,Its useful..Thanks a lot..

    If i double click in any cell only the animation stops..
    but if i want to STOP THE ANIMATION by a separate module what should i do..

    Because i am developing a sheet with the above codes
    if this macro runs its slows the other macros..

    So if have a separate module for STOP THE ANIMATION..,then i ll temporarily stop the animation and will call the other macros.thast works with out any intervention

    I really need HELP on this problem..

    Any one can help please..??

    Like

  8. dougaj4 says:

    Sarvana – how do you get the other routines to run at the same time as the animation?

    Do you have a code sample you could send? You can e-mail to my Gmail account (dougaj4)

    Like

  9. dougaj4 says:

    Saravana – I have sent a reply by e-mail

    Like

    • saravana says:

      Hi..,Freind..

      WIth your modified Codes..,I still have a small Problem..,Can you hekp me on that,,?Please

      I have send you a mail

      Like

  10. sara says:

    Can any one help please..???

    Let me attach the CODE BELOW

    Option Explicit
    Public RunWhen As Double

    Sub StartBlink()
    If Sheet3.Range(“L7”).Interior.ColorIndex = 3 Then
    Sheet3.Range(“L7”).Interior.ColorIndex = 6
    Else
    Sheet3.Range(“L7”).Interior.ColorIndex = 3
    End If
    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, “StartBlink”, , True
    End Sub

    Sub StopBlink()
    Sheet3.Range(“L7”).Interior.ColorIndex = xlAutomatic
    Application.OnTime RunWhen, “StartBlink”, , False
    End Sub

    This codes for Blinking the cell..,its working perfect
    So if some condition is met,i have called STARTBLINK same way
    if other conditon is met ..,i have called stopblink.

    Now my problem.., this codes for sheet3 only..,so
    now when i move on to next sheets,while having the CELLS BLINK in sheet3
    its showimg some ERROR MESSAGE

    runtime error 1004
    UNABLE TO SET THE COLOUR INDEXPROPERTY OF THE INTERIOR CLASS

    so can any one please help me how to avoid this..?

    Like

  11. Pingback: Daily Download 9: Animation in Excel | Newton Excel Bach, not (just) an Excel Blog

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s