Before getting down to basics, the attached file:
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 < LeftBox Or OvlX > RightBox Then xInc = -xInc
If OvlY < TopBox Or OvlY > BottBox Then yInc = -yInc
Loop
End With
End Sub
Where < and > indicate the “Less Than” and “Greater Than” symbols respectively.
Newton Excel Bach, not (just) an Excel Blog 
That’s very cool.
LikeLike
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.
LikeLike
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!
LikeLike
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..?
LikeLike
Pingback: Drawing in Excel-3 « Newton Excel Bach, not (just) an Excel Blog
Pingback: Newton’s Cradle « Newton Excel Bach, not (just) an Excel Blog
Pingback: Drawing in Excel « Golbing
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..??
LikeLike
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)
LikeLike
Hey.., thanks for the reply..,Actually i got it work by My self
but now i have another problem in some other animation….can you please HELP
LikeLike
i have send you a mail friend
LikeLike
Hey..,friend..,i have send the FILES to dougaj4@gmail.com..
Is your ID correct..???
LikeLike
Saravana – I have sent a reply by e-mail
LikeLike
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
LikeLike
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..?
LikeLike
Change the sheet number in the code
LikeLike
Pingback: Daily Download 9: Animation in Excel | Newton Excel Bach, not (just) an Excel Blog
Why did you define pi? Were you thinking of doing other things with this?
LikeLike
I don’t recall why pi was included in the code as posted, but the code in the download file is a bit longer and has two balls inside the box. Pi is used in checking if the balls collide.
You can see the full VBA code in the download file.
LikeLike