Fun code

GeorgeB

Board Regular
Joined
Feb 16, 2002
Messages
239
Here's some code that will pop up multiple stars on a worksheet at one second intervals and then remove them.

Public Sub ShowStars()
Randomize
StarWidth = 50
StarHeight = 50
For i = 1 To 100
TopPos = Rnd() * (ActiveWindow.UsableHeight - StarHeight)
LeftPos = Rnd() * (ActiveWindow.UsableWidth - StarWidth)
Set NewStar = ActiveSheet.Shapes.AddShape _
(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight)
NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56)
Delay 0.01
DoEvents
Next i

Application.Wait Now + TimeValue("00:00:01")

Set myShapes = Worksheets(1).Shapes
For Each shp In myShapes
If Left(shp.Name, 9) = "AutoShape" Then
shp.Delete
Delay 0.01
End If
Next

End Sub


Public Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime< 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime

End Sub



_________________
George
This message was edited by GeorgeB on 2002-04-02 21:24
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi George. I like this code. It's Amazing....
By the way I made a game using Cells.Interior.ColorIndex.
it seems just like a snake is moving.

‚hthink you like the program which something moves on sheet.
If you wish, I will mail it to you.

Regards,
 
Upvote 0
Hi Colo
Thanks for the offer, however my employer takes a dim view of receiving downloads from sources unknown to upper mgmt. I would like to see the code. If you could post it for all to see I'm sure it will get a lot of attention.
Thanx
George
 
Upvote 0
This is pretty cool. Now how do you get it to run automatically when you open the workbook, or open a sheet within a workbook? Tom
 
Upvote 0
Upvote 0
Tom
Put the code in either a workbook or a worksheet on activate module.
Same way you get any code to run on open.
George
 
Upvote 0
Hi George,
Can you tell me how to run the code. I don't know how to even start the code. I'm pretty new to excel.
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,306
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top