## Drawing in Excel – 2

Before getting down to basics, the attached file:

Animation demo

Illustrates how Excel shapes can be simply animated.

Screen shot:

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.

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:

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
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)
End Sub
Sheet3.Range(”L7″).Interior.ColorIndex = xlAutomatic
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

Like

4. Pingback: Drawing in Excel « Golbing

5. 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..

Like

6. 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

• saravana says:

Hey.., thanks for the reply..,Actually i got it work by My self

Like

• saravana says:

i have send you a mail friend

Like

• saravana says:

Hey..,friend..,i have send the FILES to dougaj4@gmail.com..

Like

7. 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

8. sara says:

Let me attach the CODE BELOW

Option Explicit
Public RunWhen As Double

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)
End Sub

Sheet3.Range(“L7”).Interior.ColorIndex = xlAutomatic
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