How Annonying is it now?

Give your opinion:

  • This is a bloody waste of time. You are an idiot.

    Votes: 0 0.0%
  • I wanna play too!

    Votes: 0 0.0%
  • I probably won't contribute, but I MAY use this on a coworker.

    Votes: 0 0.0%
  • This does not belong on this board.

    Votes: 0 0.0%

  • Total voters
    0

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 :lol:
Just make your modifications, tag them with comments and post them up here. :-D

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> Auto_Open()
<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>
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Forum statistics

Threads
1,222,742
Messages
6,167,922
Members
452,156
Latest member
onkey

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