Pranks and Jokes

[Ed in Aus]

Hi does anyone know anygood practicle jokes for excel... i.e. having an auto open macro that looks like the user has been infected and their pc is automatically typing each letter instead of the example i have below which just does the whole sentence at once... and any other good practicle jokes to play on the "staff" we have here at work?

I know this is sloppy just done with the recorder for most of it, could have some loops for the countdown sequence but I have a feeling that this wheel has already been invented.

Sub auto_open()
     Application.OnTime Now + TimeValue("00:00:5"), "DisplayMessage"
End Sub

Sub DisplayMessage()
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Hey Matey"
    Application.Wait (Now + TimeValue("0:00:2"))
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Bet you didn't know that you could do this huh"
    Application.Wait (Now + TimeValue("0:00:3"))
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Just taking over you computer"
    Application.Wait (Now + TimeValue("0:00:2"))
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "DON'T STESS"

    Range("A4").Select
    Selection.Font.Bold = True
    Application.Wait (Now + TimeValue("0:00:2"))
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "it is all good just having a little play"
    Application.Wait (Now + TimeValue("0:00:2"))
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "and now for the count down"
    Application.Wait (Now + TimeValue("0:00:2"))
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "5"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "4"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "3"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "2"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A11").Select
    ActiveCell.FormulaR1C1 = "no wait lets do it like this"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "5"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("A12").Select
    Application.Wait (Now + TimeValue("0:00:1"))
    ActiveCell.FormulaR1C1 = "3"
    Range("A12").Select
    Application.Wait (Now + TimeValue("0:00:1"))
    ActiveCell.FormulaR1C1 = "2"
    Application.Wait (Now + TimeValue("0:00:1"))
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "1"
    Application.Wait (Now + TimeValue("0:00:1"))
    ActiveCell.FormulaR1C1 = "Termination sequence activated"
    Selection.Font.Bold = True
    Application.Wait (Now + TimeValue("0:00:3"))
Application.DisplayAlerts = False
Application.Quit
Application.DisplayAlerts = True
End Sub

 

[mikerickson]

MsgBox "Congradulations, you've won a free upgrade to MicroSoft Excel 2007." & vbCr & 'It was installed last night."

 

[Ed in Aus]

Lol I like that... cause I know how many people would actually fall for it, I was thinking something along the lines of send keys so it does look like each key is entered... and using something like an array for the sentence with a loop to get the next letter for the sentence for the send keys part... does this make any sense???

I only wanted to do it this way so that it can be easily modified for future messages i.e. pranks, birthdays and sh**s and giggles in general

 

[Peter_SSs]

There's already a rather extensive thread on this subject:
http://www.mrexcel.com/forum/showthread.php?t=27058

 

[Ed in Aus]

i see what you mean 33 pages might just move this across to that one

 

[Lewiy]

Whilst we're here though, I don't think that this particular topic has been covered in the main thread, so here's a little routine you could try to achieve the desired effect.

I've just chucked it under a command button click event but obviously you can tailor the trigger to your needs. Also to vary the typing speed, change the max iteration values of d and e.

Private Sub CommandButton1_Click()
    Dim c As Long, d As Long, e As Long
    Dim TextLength As Long
    Dim iText As String
    iText = "Please help, I'm stuck in your PC and can't get out"
    TextLength = Len(iText)
    For c = 1 To TextLength
        For d = 1 To 5000
            For e = 1 To 5000
            Next e
        Next d
        Cells(1, 1) = Cells(1, 1) & Mid(iText, c, 1)
    Next c
End Sub

 

[cornflakegirl]

Lewiy - is there a reason for using d and e, rather than just setting d to 25,000,000?

 

[Lewiy]

Lewiy - is there a reason for using d and e, rather than just setting d to 25,000,000?

Specifically in this case, no! But having two variables allows for much larger iteration numbers when they are required. Also, I occasionally use a calculation on each iteration for which two variables are useful, if, for example, you want each iteration to take longer than the last. So it's more of an adaptable template in this instance.