Oorang
Well-known Member
- Joined
- Mar 4, 2005
- Messages
- 2,071
I was bored in class, so I popped open Excel and whipped up this. The goal is mostly just to make it as funny/pretty/annoying as possible. I'd like to see this become a group effort to make something truely hideous but harmless
Just make your modifications, tag them with comments and post them up here.
Edit: Added subliminal messages because a coworker asked me if there were any. When I thought about it, the answer seemed like it should be "yes".
<hr>
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#007F00">'Declare API</SPAN>
<SPAN style="color:#00007F">Private</SPAN> Declare <SPAN style="color:#00007F">Function</SPAN> GetSystemMetrics <SPAN style="color:#00007F">Lib</SPAN> "user32" (<SPAN style="color:#00007F">ByVal</SPAN> nIndex <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#007F00">'0 = Screen width</SPAN>
<SPAN style="color:#007F00">'1 = Screen height</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Autpen()
<SPAN style="color:#007F00">'Original Code written by Aaron Bush/Oorang 01/07/06 for bored MrExcel Members</SPAN>
<SPAN style="color:#007F00">'Aaron Bush/Oorang 01/13/2006 Added "Subliminal" messaging</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> ColumnMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> RowMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> LC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Lft <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Top <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SC2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> LeftMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> TopMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SubCounter <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">For</SPAN> LC = 1 <SPAN style="color:#00007F">To</SPAN> ActiveSheet.Shapes.Count
ActiveSheet.Shapes(1).Delete
<SPAN style="color:#00007F">Next</SPAN> LC
Randomize
<SPAN style="color:#007F00">'Need to add settings for other resolutions so for now ALL resolutions</SPAN>
<SPAN style="color:#007F00">'will trigger these settings.</SPAN>
Cells.ClearContents
<SPAN style="color:#00007F">GoTo</SPAN> Point1
<SPAN style="color:#00007F">If</SPAN> GetSystemMetrics(0) = 1024 And GetSystemMetrics(1) = 768 <SPAN style="color:#00007F">Then</SPAN>
Point1:
ColumnMax = 15
RowMax = 35
LeftMax = 500
TopMax = 350
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
ActiveSheet.Shapes.AddShape(17, 1, 101.25, 56.25, 54#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Line.ForeColor.SchemeColor = 0
ActiveSheet.Shapes.AddShape(21, 117#, 1, 80.25, 69#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45
Selection.ShapeRange.Line.ForeColor.SchemeColor = 45
ActiveSheet.Shapes.AddShape(24, 198.75, 111.75, 36.75, 70.5).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Line.ForeColor.SchemeColor = 12
ActiveSheet.Shapes.AddShape(92, 357.75, 102.75, 87#, 87#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Line.ForeColor.SchemeColor = 5
ActiveSheet.Shapes.AddShape(107, 116.25, 56.25, 152.25, 75#).Select
Selection.Characters.Text = "GIVE AARON A RAISE"
Selection.Characters(Start:=1, Length:=18).Font.FontStyle = "Bold"
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">For</SPAN> LC = 1 <SPAN style="color:#00007F">To</SPAN> 20000
<SPAN style="color:#00007F">If</SPAN> LC Mod 10 = 0 <SPAN style="color:#00007F">Then</SPAN>
ActiveSheet.Shapes(1).Fill.ForeColor.SchemeColor = SC
<SPAN style="color:#00007F">If</SPAN> SC >= 56 Then: SC = 1: Else: SC = SC + 1
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
Cells(Int((RowMax - 1 + 1) * Rnd + 1), Int((ColumnMax - 1 + 1) * Rnd + 1)).Interior.ColorIndex = ((56 - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">If</SPAN> LC Mod 100 = 0 <SPAN style="color:#00007F">Then</SPAN>
Cells.Interior.ColorIndex = ((56 - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">For</SPAN> SC2 = 1 <SPAN style="color:#00007F">To</SPAN> 5
ActiveSheet.Shapes(SC2).IncrementLeft Int((LeftMax - 1 + 1) * Rnd + 1) * -1
ActiveSheet.Shapes(SC2).IncrementTop Int((<SPAN style="color:#00007F">To</SPAN>pMax - 1 + 1) * Rnd + 1) * -1
<SPAN style="color:#00007F">Next</SPAN> SC2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 50 = 0 And LC Mod 100 <> 0 <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">For</SPAN> SC2 = 1 To 5
ActiveSheet.Shapes(SC2).IncrementLeft Int((LeftMax - 1 + 1) * Rnd + 1)
ActiveSheet.Shapes(SC2).Increment<SPAN style="color:#00007F">To</SPAN>p Int((TopMax - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">Next</SPAN> SC2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 150 = 0 <SPAN style="color:#00007F">Then</SPAN>
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">True</SPAN>
SubCounter = LC
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> SubCounter + 1 = LC And SubCounter <> 0 <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Sub</SPAN>Counter = 0
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 15 = 0 <SPAN style="color:#00007F">Then</SPAN>
Cells(Int((RowMax - 1 + 1) * Rnd + 1), Int((ColumnMax - 1 + 1) * Rnd + 1)) = "GIVE AARON A RAISE"
Cells.ClearContents
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> LC
<SPAN style="color:#00007F">For</SPAN> LC = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(1).Delete
<SPAN style="color:#00007F">Next</SPAN> LC
<SPAN style="color:#00007F">End</SPAN> Sub
</FONT>
Just make your modifications, tag them with comments and post them up here.
Edit: Added subliminal messages because a coworker asked me if there were any. When I thought about it, the answer seemed like it should be "yes".
<hr>
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#007F00">'Declare API</SPAN>
<SPAN style="color:#00007F">Private</SPAN> Declare <SPAN style="color:#00007F">Function</SPAN> GetSystemMetrics <SPAN style="color:#00007F">Lib</SPAN> "user32" (<SPAN style="color:#00007F">ByVal</SPAN> nIndex <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#007F00">'0 = Screen width</SPAN>
<SPAN style="color:#007F00">'1 = Screen height</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Autpen()
<SPAN style="color:#007F00">'Original Code written by Aaron Bush/Oorang 01/07/06 for bored MrExcel Members</SPAN>
<SPAN style="color:#007F00">'Aaron Bush/Oorang 01/13/2006 Added "Subliminal" messaging</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> ColumnMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> RowMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> LC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Lft <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Top <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SC2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> LeftMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> TopMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SubCounter <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">For</SPAN> LC = 1 <SPAN style="color:#00007F">To</SPAN> ActiveSheet.Shapes.Count
ActiveSheet.Shapes(1).Delete
<SPAN style="color:#00007F">Next</SPAN> LC
Randomize
<SPAN style="color:#007F00">'Need to add settings for other resolutions so for now ALL resolutions</SPAN>
<SPAN style="color:#007F00">'will trigger these settings.</SPAN>
Cells.ClearContents
<SPAN style="color:#00007F">GoTo</SPAN> Point1
<SPAN style="color:#00007F">If</SPAN> GetSystemMetrics(0) = 1024 And GetSystemMetrics(1) = 768 <SPAN style="color:#00007F">Then</SPAN>
Point1:
ColumnMax = 15
RowMax = 35
LeftMax = 500
TopMax = 350
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
ActiveSheet.Shapes.AddShape(17, 1, 101.25, 56.25, 54#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Line.ForeColor.SchemeColor = 0
ActiveSheet.Shapes.AddShape(21, 117#, 1, 80.25, 69#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45
Selection.ShapeRange.Line.ForeColor.SchemeColor = 45
ActiveSheet.Shapes.AddShape(24, 198.75, 111.75, 36.75, 70.5).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Line.ForeColor.SchemeColor = 12
ActiveSheet.Shapes.AddShape(92, 357.75, 102.75, 87#, 87#).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Line.ForeColor.SchemeColor = 5
ActiveSheet.Shapes.AddShape(107, 116.25, 56.25, 152.25, 75#).Select
Selection.Characters.Text = "GIVE AARON A RAISE"
Selection.Characters(Start:=1, Length:=18).Font.FontStyle = "Bold"
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">For</SPAN> LC = 1 <SPAN style="color:#00007F">To</SPAN> 20000
<SPAN style="color:#00007F">If</SPAN> LC Mod 10 = 0 <SPAN style="color:#00007F">Then</SPAN>
ActiveSheet.Shapes(1).Fill.ForeColor.SchemeColor = SC
<SPAN style="color:#00007F">If</SPAN> SC >= 56 Then: SC = 1: Else: SC = SC + 1
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
Cells(Int((RowMax - 1 + 1) * Rnd + 1), Int((ColumnMax - 1 + 1) * Rnd + 1)).Interior.ColorIndex = ((56 - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">If</SPAN> LC Mod 100 = 0 <SPAN style="color:#00007F">Then</SPAN>
Cells.Interior.ColorIndex = ((56 - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">For</SPAN> SC2 = 1 <SPAN style="color:#00007F">To</SPAN> 5
ActiveSheet.Shapes(SC2).IncrementLeft Int((LeftMax - 1 + 1) * Rnd + 1) * -1
ActiveSheet.Shapes(SC2).IncrementTop Int((<SPAN style="color:#00007F">To</SPAN>pMax - 1 + 1) * Rnd + 1) * -1
<SPAN style="color:#00007F">Next</SPAN> SC2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 50 = 0 And LC Mod 100 <> 0 <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">For</SPAN> SC2 = 1 To 5
ActiveSheet.Shapes(SC2).IncrementLeft Int((LeftMax - 1 + 1) * Rnd + 1)
ActiveSheet.Shapes(SC2).Increment<SPAN style="color:#00007F">To</SPAN>p Int((TopMax - 1 + 1) * Rnd + 1)
<SPAN style="color:#00007F">Next</SPAN> SC2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 150 = 0 <SPAN style="color:#00007F">Then</SPAN>
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">True</SPAN>
SubCounter = LC
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> SubCounter + 1 = LC And SubCounter <> 0 <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Sub</SPAN>Counter = 0
ActiveSheet.Shapes(5).Visible = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> LC Mod 15 = 0 <SPAN style="color:#00007F">Then</SPAN>
Cells(Int((RowMax - 1 + 1) * Rnd + 1), Int((ColumnMax - 1 + 1) * Rnd + 1)) = "GIVE AARON A RAISE"
Cells.ClearContents
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> LC
<SPAN style="color:#00007F">For</SPAN> LC = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(1).Delete
<SPAN style="color:#00007F">Next</SPAN> LC
<SPAN style="color:#00007F">End</SPAN> Sub
</FONT>