# Good Excel Practical Jokes, Pranks, Mean Tricks, etc.



## Chris The Rock

A coworker of mine and me (he's a Board Master here) were talking about some mean things we could do using VBA . . . like pranks, practical jokes and the like.  April Fool's kind of stuff.

Any ideas?  Has anyone done anything like this?


----------



## s-o-s

A good one to play on someone who you regularly send an excel file to (with macros in so that they do not become suspicious by the prompt) is to add in an auto open macro that contains an On Time call macro that pops up a message box warning them that XYZ virus has infected their machine...Please contact the Network Administrator Immediately...Wait until just after they have called the NT admin before alerting them to the prank...Then get out fast...


----------



## elgringo56

I have a customer whose computer I regularly maintain, he is somewhat of a computer dolt, but thinks he is a whiz.  On fixing one of his self created problems once, I got into one of his exel files and set it up so that when he selected a certian cells, a msg box would pop up and say something like, "Bill, we at microsoft have spent billions to perfect this software and make it as user friendly as possible, have you ever considered takeing a course or two on how to use it", or, "Bill, it is time that some one told you that you maybe should take this computer back to where you purchased it and try and get your money back, because you just arn't smart enought to use a computer".  I have several cell set up within his main spread sheet that should keep him guessing as to what is going on for a long long time.


----------



## Iridium

How about having a macro that plays a paricularly loud and long wav file on entry of data into a particular cell - enough to cause panic in many colleagues when the boss is prowling about


----------



## Sourdust

It's maybe my evil mind but I like this idea . I once set up a user on a Novell network to have to change their password daily and the password had to have at least 40 characters. I pleaded ignorance for about a week before owning up! I like the idea of various messages popping up when a certain cell is selected. Can anybody help me with the code for that , I'm just starting to learn VBA.

Thanks for the laughs.


----------



## applebyd

Going back and not particularly Excel related.

I once wrote a routing (c1991) into the MS-DOS Autoexec.Bat file to emulate the Format command without actually doning anything.

Luckily my boss was the author of the appliction being run and saw the funny side.

DaveA

edit:typos
This message was edited by  applebyd on 2002-11-06 07:39


----------



## Bruno_x

What about this :
Put the following code in an excel file, copy the file to the XLSTART folder...
This could take days to find out...

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.Quit
End Sub


----------



## Corticus

Cool topic 

I accidently did this to myself once, it took me too long to figure out why _nothing_ was working....

Private Sub Workbook_Open()

Application.EnableEvents = False

End Sub

-Corticus


----------



## Von Pookie

How in the world did you manage to do that to _yourself_?


----------



## Chris The Rock

This is a great thread.

I was thinking of a mean trick...

On workbook open, pop up a userform with a little "quiz" on it.  Unless the user gets the questions right, the workbook closes and tells them that they're not allowed to open it.


----------



## Von Pookie

Sounds like you're suggesting the copy protection of some of my old games 

Edit: typooooooooooo
_________________<font color="#3399FF" size="3">*Kristy*</font>
This message was edited by  Von Pookie on 2002-11-07 09:23


----------



## Iridium

> On 2002-11-06 05:39, Sourdust wrote:
> It's maybe my evil mind but I like this idea . I once set up a user on a Novell network to have to change their password daily and the password had to have at least 40 characters. I pleaded ignorance for about a week before owning up! I like the idea of various messages popping up when a certain cell is selected. Can anybody help me with the code for that , I'm just starting to learn VBA.
> 
> Thanks for the laughs.



Found this on my internet travels - should get you started

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A1:C10")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
        MsgBox "Cell " & Target.Address & " has changed."

    End If
End Sub


----------



## Sourdust

Thanks very much Chris. I'm getting a basic understanding of VBA now and I can justify a project like this as part of the learning process. I have had a few people shaking their heads and calling me sad when they see my Walkenbach book at the side of the computer but I don't care I'm enjoying VBA.
Ian


----------



## Corticus

> On 2002-11-06 10:06, Von Pookie wrote:
> How in the world did you manage to do that to _yourself_?




See for yourself:
http://www.mrexcel.com/board/viewtopic.php?topic=21666&forum=2

VBA is just a way to automate mistakes so they screw up over and over and over really fast, with just the click of a button 

And for some more fun, check this out:
http://www.mrexcel.com/board/viewtopic.php?topic=14424&forum=12





_________________<EMBED width="118" height="52" src="http://dacypha0.tripod.com/Images/Corticus.swf"></EMBED>
This message was edited by  Corticus on 2002-11-07 11:54


----------



## Von Pookie

<font size="5" color="red">V</font>indictive
<font size="5" color="red">B</font>uggy
<font size="5" color="red">A</font>ggravator


----------



## s-o-s

> On 2002-11-06 09:29, Bruno wrote:
> What about this :
> Put the following code in an excel file, copy the file to the XLSTART folder...
> This could take days to find out...
> 
> Private Sub Workbook_Open()
> Application.DisplayAlerts = False
> Application.Quit
> End Sub



Bruno,

I like your one...Add a little more and you have loads of fun...

How about a message box that Pops Up..."After full analysis of the history files, this computer has decided you are to stupid to operate it...Press OK to continue."

then application quits.

I can think of a number of similar tricks along this line. 
	

	
	
		
		

		
		
	


	




_________________
Hope This Helps.
Sean.



Win98, XL2000
This message was edited by  s-o-s on 2002-11-08 07:27


----------



## Bruno_x

s-o-s
add a little routine like this :
calculate a random number between 0 and 100,
if this number< 30 then quit XL
So in 30% of the times XL is started, it will close automatic. The user will find this very annoying  ? ?


		VBA Code:
__


Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    Randomize
    annoying_level = 30
    annoying_number = 100 * Rnd
    If annoying_number< annoying_level Then
        Application.Quit
    End If
End Sub

This message was edited by  Bruno on 2002-11-08 08:29


----------



## Corticus

That's brilliant Bruno,

sadisticly brilliant but brilliant nonetheless!


----------



## Mark O'Brien

The only thing I had was an add-in I created for my last job after I'd quit.  I live in Ohio and people in Central Ohio in particular take college American Football far too seriously.  (mainly because they don't have a pro American football team here I suppose, unlike Cleveland and Cinci)  Anyway the main perceived rivalry for Ohio State Uni is Michigan.  So my add-in was placed on all of the OSU "fans'" computers.  It was set to run 1 week after I'd quit.  Whenever Excel was opened, it would replace the Excel splash screen with a Michigan flag and it would play the Michigan fight song.  Sad, I know, but what was even worse was the fact that this really annoyed them for some reason.  It's just a game.


----------



## Von Pookie

You're a vindictive little bugger, ain't ya? :wink:


----------



## Mark O'Brien

> On 2002-11-08 10:09, Von Pookie wrote:
> 
> 
> You're a vindictive little bugger, ain't ya? :wink:



The main reason I left was that I wasn't in the clique.  (the 56% raise I got to switch jobs was merely a nice side effect)


----------



## Corticus

A little more fun...

put this in any financial spreadsheet, or I guess anywhere for that matter:


		Code:
__


Private Sub Worksheet_Change(ByVal Target As Range)

Dim Level As String
Dim Occurance As Integer

Frequency = 0.3
Level = 0.0000001

On Error Resume Next

Application.EnableEvents = False

If Target.Value< Level Then End
If Rnd()< Frequency Then Target = Target + Level

Application.EnableEvents = True

End Sub


edit:
In case you wondered what this does...It randomly(frequency) adds a very small amount(level) to every entry made in a sheet.  The amounts should not be enough to notice until its time to reconscile...hehehe
This message was edited by  corticus on 2002-12-19 12:17


----------



## Bruno_x

Corticus,
a variation on my code :
<pre>
Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    Randomize
    annoying_level = 8 * weekday(now())
    annoying_number = 100 * Rnd
    If annoying_number < annoying_level Then
        Application.Quit
    End If
End Sub</pre>

On sunday the annoying_level will be 8, on monday 16, on tuesday 24, etc.
'During the week, the PC get tired to start XL'  :wink:


----------



## EdE

Hey Mark --

You wouldnt happen to still have that code for the Michigan prank you pulled?  I have the same problem here with Colorado/Colorado State.  Would love to get a few Buffalo fans irked.

Thanks!!


----------



## DBA

Hi Guys and Gals,

If you haven't the time to hoik some VBA, just do as I do and slip into their auto correct. An endless source of fun - especially if your colleagues are not apt to proof read their work. (Good on Excel but works even better on Word).

Try these -
Replace "the" with "the ****" - Works well on sentences like -
"The manager of the company has approved the loan."
Or this gem -
Replace "you" with "you idiots" - Good for -
"I'd like to thank you for the kind gift you sent me yesterday"
Or even - 
Replace "Brian" (use the person's name) with "Brian (your love puppet)" - Imagine this -
"Thank you for your trust in me, Sir. I won't let you down. Regards, Brian"

And these are just the mild ones. How far are you willing to push it?

Let us know.

DBA


----------



## Corticus

DBA,

That's too funny!  I'm a little late on the post, but your prank is classic.  Now if only we could put our powers to good...


----------



## Sourdust

Too funny DBA  

I am already planning how far I can go without getting the sack!


----------



## Pesky_Weasel

Now this is funnee!
I almost cant wait for work on Monday, speaking of which, anyone got a job for me? (In case some of this doesn't go down so well)


----------



## k209310

I have recently been experimenting with the Ascii code for the keyboard. 

You could put the code in to akeypress fucntion and then put a template in the start up file. 

This would prevent to prevent certain letters from being used. This would annoy the hell out of the users you wish to get. You could cost your company a fortune in new keyboards.


----------



## NateO

If I wasn't anticipating the following, it would surely irritate me, to say the least.

http://www.mrexcel.com/board/viewtopic.php?topic=27145&forum=2

Even nastier would be to not reset it. 

_________________
Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
This message was edited by  nateo on 2002-12-05 21:46


----------



## Von Pookie

Nate = Eeeeeeeeevil


----------



## NateO

> On 2002-12-05 14:09, Von Pookie wrote:
> Nate = Eeeeeeeeevil



Hey Pook, just trying to help the OP. 

I found myself irritated while playing with it, while knowing full well it was there.

Edit: The code gets even gnarlier. If you the disable twice, you have to run re-enable twice to get a mouse back in Excel, although it will clear up in other apps, it's actually released, it's just not visible in Excel. 

_________________
Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
This message was edited by  NateO on 2002-12-05 21:54


----------



## Von Pookie

Well, it's not really an Excel thing, but there's always the classics:

1) If the mouse isn't optical or anything, simply remove the ball when they're not around and then sit back and watch the fun when they try to figure out why their mouse isn't working anymore.

2) Take a screen capture of their desktop, and save it as a jpg or bmp file. Turn on the Active Desktop, and make sure to turn off "show desktop icons". Change their wallpaper to the screen capture image you just took, and watch as they click away on their "icons" that mysteriously stopped working.


----------



## brettvba

Feel free to try the following does what the sub name says.


Sub ReverseMenuText()
On Error Resume Next
For Each m1 In Application.CommandBars(1).Controls
m1.caption = Reverse(m1.caption)
For Each m2 In m1.Controls
m2.caption = Reverse(m2.caption)
For Each m3 In m2.Controls
m3.caption = Reverse(m3.caption)
Next m3
Next m2
Next m1
End Sub


Function Reverse(MenuText As String) As String
Dim Temp As String, Temp2 As String
Dim ItemLen As Integer, i As Integer
Dim HotKey As String * 1
Dim Found As Boolean

ItemLen = Len(MenuText)
Temp = ""
For i = ItemLen To 1 Step -1
If Mid(MenuText, i, 1) = "&" Then _
HotKey = Mid(MenuText, i + 1, 1) _
Else Temp = Temp & Mid(MenuText, i, 1)
Next i
Temp = Application.Proper(Temp)
Found = False
Temp2 = ""
For i = 1 To ItemLen - 1
If UCase(Mid(Temp, i, 1)) = UCase(HotKey) And Not Found Then
Temp2 = Temp2 & "&"
Found = True
End If
Temp2 = Temp2 & Mid(Temp, i, 1)
Next i
If Left(Temp2, 3) = "..." Then Temp2 = Right(Temp2, ItemLen - 3) & "..."
Reverse = Temp2
End Function


----------



## Sourdust

Not nearly as clever but inspired by this thread I recently sent a file to a group of users who don't even know of the existence of VBA (I do at least know that much). I added code to show the message "If this message appears the user needs his/her nails cut". 

Believe it or not two of them got the nail clippers out  It was only when the rest thought about who had sent it that they began to smell a rat. I now sit here waiting for their revenge.


----------



## Legacy 98055

I'll have to find this one.  My wife nagged me about finishing up a spreadsheet which organized and budgeted her grocery shopping.  So I threw in some code in which the Office Assistant waited patiently for her to type anything in any cell and summarily coasted down and deleted the entry and then went back up to the corner of the screen to play again. 
Unfortunetely, she didn't get mad but was instead impressed.
Tom


----------



## entity789

I'd love to see that.  Any way to get the assistant to say something unique?  or respond to specific data entry?  

eg. person mispells something or enters a certain value into a cell and the assistant pops up and calls said person a random name then disappears.


----------



## NateO

> On 2002-12-10 16:03, entity789 wrote:
> I'd love to see that.  Any way to get the assistant to say something unique?  or respond to specific data entry?



Well here's a moderated version of this (for Jack) as an example of controlling our favourite little bugger: Clippy:<pre>
Sub Helper()
Dim rspns As Integer
    Set myBalloon = Assistant.NewBalloon
    With myBalloon
        .BalloonType = msoBalloonTypeButtons
        .Button = msoButtonSetNone
        .Text = "It looks like you're working on a spreadsheet." _
            & Application.Rept(Chr(13), 2) & "Would you like me to:"
        .Labels(1).Text = "******** it up for you"
        .Labels(2).Text = "Just f*** off and leave you alone"
        rspns = .Show
    End With
Select Case rspns
    Case 1: Cells.Clear
End Select
End Sub</pre>



You could very easily refer to ranges, etc...

_________________
Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
This message was edited by  nateo on 2002-12-10 20:16


----------



## brettvba

> On 2002-12-10 16:41, NateO wrote:
> 
> 
> 
> On 2002-12-10 16:03, entity789 wrote:
> I'd love to see that.  Any way to get the assistant to say something unique?  or respond to specific data entry?
> 
> 
> 
> 
> Well here's a moderated version of this (for Jack) as an example of controlling our favourite little bugger: Clippy:<pre>
> Sub Helper()
> Dim rspns As Integer
> Set myBalloon = Assistant.NewBalloon
> With myBalloon
> .BalloonType = msoBalloonTypeButtons
> .Button = msoButtonSetNone
> .Text = "It looks like you're working on a spreadsheet." _
> & Application.Rept(Chr(13), 2) & "Would you like me to:"
> .Labels(1).Text = "******** it up for you"
> .Labels(2).Text = "Just f*** off and leave you alone"
> rspns = .Show
> End With
> Select Case rspns
> Case 1: Cells.Clear
> End Select
> End Sub</pre>
> 
> 
> 
> You could very easily refer to ranges, etc...
> 
> _________________
> Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
> This message was edited by  nateo on 2002-12-10 20:16
Click to expand...


Nice one Nate

Brett


----------



## Corticus

Hey all,

Somebody actally _wanted_ to do this, 
http://216.92.17.166/board/viewtopic.php?topic=32683&forum=2
and upon figuring it out, I realized it's actually pretty annoying.  Not nearly so brilliant as some of the previous posts, but annoying nonetheless...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Cancel = True

End Sub

Corticus


----------



## just_jon

pretty sophomoric, compared to the code you all have written, but you can get a cheap thrill by taking someone's open - and unattended - workbook and off-clicking the show formula bas and changing all font colors to white.
just_jon


----------



## Bruno_x

Corticus, I've not here for a while but euh,
very nice idea  

add this :
Private Sub Workbook_Open()
   Do
       Beep
   Loop Until forever
End Sub

Put this in a file called Secret.xls, somewhere in the network where all the users have access... and enjoy...


----------



## Iridium

Anyone know how to change the language settings in Excel with a (auto_open) macro? I think for most of the English speaking nations any foreign language would leave most users stumped but how about changing it to say Chinese or Arabic?


----------



## Jack in the UK

Chris

I would post this on the main board, its relavant and you wnt to know how to do an Excel things

Ive no intrest in being silly in such a fashion, very childish, unprofessional and not to encourage the children.

Please stop this kinda of yopish youth attitude to this site OK or better still can we have 100 times more and monkey about is such more fun!!!! cause agro and be silly much more ?? YES i vote!


Chris i like this one!! he he!!! yup im planning!!!!


----------



## TommyGun

Very nice stuff in here!!!  I love the auto open codes, those are great!  Keep up the evil genius!


----------



## TommyGun

Okay, so I have an idea, but no earthly idea if it's possible, or how to do it, but here goes:

It goes off the same idea about the random number to kill XL, but instead of just killing XL, could you send the user back to the Login screen?  Basically log the user off when they start XL.  Would this be possible in VBA?


----------



## NateO

Howdy y'all, I have (2) too many posts to this thread. But what do y'all think of this Christmas treat:

<pre>
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
        ByVal lParam As Long) As Long

Declare Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, ByVal _
    lpWindowName As String) As Long

Sub Wowee_Zowie()
Call SendMessage(FindWindow("xlMain", vbNullString), &HB, 0, 0)
End Sub</pre>

? 

Happy Holidays,
Nate


----------



## NateO

> Would this be possible in VBA?



Howdy Tom, try the following on for size:<pre>
Private Declare Function ExitWindowsEx Lib "user32.dll" _
    (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Declare Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, ByVal _
    lpWindowName As String) As Long

Public Sub LogOff()
Dim wb As Workbook
LockWindowUpdate FindWindow("xlMain", vbNullString)
For Each wb In Application.Workbooks
    If wb.Name<> ThisWorkbook.Name Then wb.Close False
Next wb
ExitWindowsEx 0, 0
End Sub</pre>

Works well in my environment. 

_________________
Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
This message was edited by  nateo on 2002-12-18 19:13


----------



## Iridium

> On 2002-12-18 14:28, Jack in the UK wrote:
> Chris
> 
> I would post this on the main board, its relavant and you wnt to know how to do an Excel things
> 
> Ive no intrest in being silly in such a fashion, very childish, unprofessional and not to encourage the children.
> 
> Please stop this kinda of yopish youth attitude to this site OK or better still can we have 100 times more and monkey about is such more fun!!!! cause agro and be silly much more ?? YES i vote!
> 
> 
> Chris i like this one!! he he!!! yup im planning!!!!



 Jack


----------



## TommyGun

Nice stuff NateO, I'll try this later.


----------



## TommyGun

Just thought of one:

Sub Workbook_Open()

Application.Visible = False

Dim wdApp as Word.Application

Set wdApp = New Word.Application

wdApp.Visible=True
Set wdApp = Nothing

Application.DisplayAlerts = False

Application.Quit

End Sub

Now every time they fire up XL, it will shut down, and open Word.  

Not very hurtful, but definitely annoying.

Don't forget to add a reference to the Word Library.

_________________
I'm on my way to being a programmer!  Well, I've at least bought the books.  LOL
This message was edited by  TommyGun on 2002-12-19 11:24 
This message was edited by  TommyGun on 2002-12-19 11:29


----------



## JamesKM

Not sure how to do this (please help), but I get a lot of calls (amazingly) as people say their spreadhseets aren't working properly. 

I go over and press "Scroll Lock" and hey presto it works. They are pretty dumb.

Is there a way I can put an auto open (in their personal.xls) to turn on scroll lock when opening xl?


----------



## Wayne Duncan

Not an Excel trick but my level of lo-tech.  On better keyboards the key covers snap off quite easily: When the victim is away from his desk, interchange the key caps on the number pad numbers "1-2-3" with the "7-8-9" key caps. Now it looks just like a telephone keypad...takes a long time to spot.


----------



## NateO

Howdy James,



> Is there a way I can put an auto open (in their personal.xls) to turn on scroll lock when opening xl?



Well, placing it in their personal may be going a little far, but the following will toggle your scroll lock:<pre>
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
    (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
    (lppbKeyState As Byte) As Long

Const VK_SCROLL = &H91
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1


Sub Scroll()
Dim o As OSVERSIONINFO, keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
    keys(VK_SCROLL) = 1
    SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
    keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY _
        Or KEYEVENTF_KEYUP, 0
End If
End Sub</pre>

Good hunting. 
_________________
Cheers,<font size=+2><font color="red">_* Nate<font color="blue"> Oliver</font></font></font>*_
This message was edited by  NateO on 2003-01-06 20:39


----------



## The Idea Dude

I had a problem with my entire office suite a while back.  It didn't matter which program I opened (excel, word, frontpage, etc), after about 5 seconds it just closed.  I even tried uninstalling and reinstalling office, but it did not fix the problem.  What a pain in the *** that was


----------



## The Idea Dude

How about this idea.  Whenever a cell is selected, and 2 seconds has passed, the active cell becomes cell IV65536


----------



## Colo

<pre>
Private Sub MrExcelMessageBoard_Activate(ByVal Zero_Replies As Topics)
    Dim BrowsingTime As Time
    Dim Topic As Object
    BrowsingTime = Now
    For Each Topic In Zero_Replies
        Read Topic.MessageBody
        Do Until The_Good_Idea.Found = True
            Thinking
        Loop
        Reply
    Next
    MsgBox Now - BrowsingTime, vbQuestion, Title:="How long have you been here?"
End Sub
</pre>


----------



## TommyGun

LOL

Hey Colo write a program to post XL sheets to the board from Netscape.


----------



## Colo

> On 2003-01-09 10:29, TommyGun wrote:
> LOL
> 
> Hey Colo write a program to post XL sheets to the board from Netscape.



Hi Tommy,
Yea, that's great if I could hadle Netscape via XL. I have no idea with me now...
Could you teach me? LOL


----------



## TommyGun

Well if the master 
	

	
	
		
		

		
		
	


	




  can't do it then I sure as heck can't do it.

Oh well, I guess it was just wishful dreaming.   
	

	
	
		
		

		
		
	


	



This message was edited by  TommyGun on 2003-01-10 08:28


----------



## DreamAlchemist

THis Works in any program that lets you customize the icons on a toolbar.

First I hate Icons I prever to use keyboard commands so to force others to use them as well they end up with a closed workbook if they use the mouse to click an icon.

How its done.

Tools/Customize

select the icon you want the close icon to look like and modify/copy selected.

Then put the close icon up on the toolbar modify/paste image (it will now look like the other icon, which you now remove from the toolbar.)

I did this with the new open save cut copy and paste icons.

To correct just drag the icon off and put the original command back up.


----------



## Corticus

As a counterpart to the:
Challenge of the Month,

how about:
Annoyance of the Month

I think this thread demonstrates we'll have no paucity of entries.

There's some really great stuff in here!


----------



## Chris The Rock

Wow,
Amazing how much evil genius resides in such a group of nice people.

It was my plan to make this the longest-running thread on the board.  Some of the ideas on here are great!


----------



## golf4

Hi, everyone -

Really like the pranks and jokes. I saw the one posted by Bruno re the code:

Private Sub Workbook_Open() 
Do 
Beep 
Loop Until forever 
End Sub .

I was wondering how I would amend the code to have it beep for about 5 seconds, pop up an annoying text box with my message, and resume beeping after acknowledging the box?

Thanks


----------



## Bruno_x

Hi Golf4,  try this :
<pre>
Private Sub Workbook_Open()
PauseTime = 5
Start = Timer
Do While Timer < Start + PauseTime
    Beep
Loop

MsgBox "Your message here..."

Do
    Beep
Loop Until forever

End Sub </pre>


----------



## TommyGun

Hey guys, been working on this one, and it's pretty good.

It uses the Application level event handlers to change the status bar, but doesn't reset the status bar control to Excel.  I have a list of messages in the first sheet of the "Personal" workbook, and it randomly picks a message each time it captures an event.

Here's an example:

<pre>Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)

Randomize

Dim rnNum As Integer
Dim upLim As Integer

upLim = Application.CountA(Workbooks("Personal.xls").Sheets(1).Columns(1))

rnNum = Int((upLim - 1 + 1) * Rnd + 1)

Application.StatusBar = Workbooks("Personal.xls").Sheets(1).Cells(rnNum, 1).Value

End Sub</pre>

It doesn't hurt anything, it can just be pretty funny.

I also set up a procedure to play a WAV file at a randomly generated time interval.  Haven't tested it yet, but I think it'll work.

<pre>Private Sub Workbook_Open()

Set AppClass.App = Application

Dim rnNum As Integer
rnNum = Int((1200 - 1 + 1) * Rnd + 1)

Application.OnTime DateAdd("s", rnNum, Now()), "GetWAV", DateAdd("s", rnNum + 10, Now())

End Sub

'========================================

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
    "sndPlaySoundA" (ByVal lpszSoundName As String, _
    ByVal uFlags As Long) As Long

Private Sub GetWAV()

On Error Resume Next

Call sndPlaySound32("c:usrquackers.WAV", 0)

Dim rnNum As Integer
rnNum = Int((1200 - 1 + 1) * Rnd + 1)

Application.OnTime DateAdd("s", rnNum, Now()), "GetWAV", DateAdd("s", rnNum + 10, Now())

End Sub</pre>


----------



## golf4

Hi, Bruno -

Works like a charm....... Thanks for the help!!!


----------



## Colo

How abt this?

<pre>
'// Thisworkbook Module
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime Now, "ReOpen"
End Sub

'// Std Module
Sub ReOpen()
    Workbooks.Open ThisWorkbook.FullName
End Sub
</pre>


----------



## Bruno_x

Nice Colo, very nice   
Now i have to work all day looooong....


----------



## Ivan F Moala

You can Always start the default screen save
through some event eg Sheet Activate or change......

<pre>
Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function BlockInput Lib "user32" ( _
    ByVal fBlock As Long) As Long

Private Declare Sub Sleep Lib "kernel32" ( _
    ByVal dwMilliseconds As Long)

Private Const WM_SYSCOMMAND As Long = &H112&
Private Const SC_SCREENSAVE As Long = &HF140&

Sub StartScreenSaver()
'// Starts Default ScrnSaver
'// By Ivan F Moala
Dim lRet As Long

lRet = SendMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)

    DoEvents
'// Disable any inputs via mouse or keyboard
    BlockInput True
'// pause 10 seconds before unblocking it
    Sleep 10000
'// Enable inputs via mouse or keyboard
    BlockInput False

End Sub
</pre>


----------



## Von Pookie

Just bumping this back up in honor of April Fool's Day (though I hate it with a passion).


----------



## NateO

Here's a doosey, and you can call this from a worksheet!   

<pre><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> FindWindow <FONT COLOR="#00007F">Lib</FONT> "User32" Alias "FindWindowA" _
    (<FONT COLOR="#00007F">ByVal</FONT> lpClassName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpWindowName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>

<FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SetWindowRgn <FONT COLOR="#00007F">Lib</FONT> "User32" _
    (<FONT COLOR="#00007F">ByVal</FONT> hwnd <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> hRgn <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, _
        <FONT COLOR="#00007F">ByVal</FONT> bRedraw <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Boolean</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>


<FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> CreateEllipticRgn <FONT COLOR="#00007F">Lib</FONT> "gdi32" _
    (<FONT COLOR="#00007F">ByVal</FONT> X1 <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> Y1 <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> X2 <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, _
        <FONT COLOR="#00007F">ByVal</FONT> Y2 <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>




<FONT COLOR="#00007F">Function</FONT> AlterEn()
<FONT COLOR="#00007F">Dim</FONT> hRgn <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>
hRgn = CreateEllipticRgn(0, 0, 150, 150)
SetWindowRgn FindWindow("XLMAIN", Application.Caption), hRgn, <FONT COLOR="#00007F">True</FONT>
<FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Function</FONT></pre>

Go into a cell and enter 

=AlterEn()

So much not manipulating the object via udf...


----------



## Juan Pablo González

Just wanted to post an easier version to copy to the VBE:

Option Explicit

Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SetWindowRgn Lib "User32" _
    (ByVal hwnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long

Private Declare Function CreateEllipticRgn Lib "gdi32" _
    (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long) As Long


Function AlterEn()
Dim hRgn As Long
hRgn = CreateEllipticRgn(0, 0, 150, 150)
SetWindowRgn FindWindow("XLMAIN", Application.Caption), hRgn, True
End Function


----------



## Mark O'Brien

I just thought of a prank by accident.  I just copied some worksheets to sort them and suchlike.  I removed the colour formatting from all of the cells on the sheet by setting the cell fill pattern to "No Fill".  However, cell H2 was formatted with a yellow colour.  It only took a minute to realise that I'd been messing with Conditional Formatting and forgot to remove the formatting for that cell.  So, my prank is this:

Choose a cell or range of cells e.g. Cell A1
Goto Format|Conditional Formatting...
Select the condition Cell Value is Equal to A1
Insert whatever formatting conditions you want. e.g. make the background pattern yellow for that inexplicable miscellaneous cell whose formatting you can't change.  Change the font colour to match the background for the classic "inivisble" cell contents.

The beauty of this one is that there is no VBA involved.


----------



## Von Pookie

I don't feel like cross-posting this at the moment, so just follow the link to my post with Microsoft-supplied meanness. 

http://www.mrexcel.com/board2/viewtopic.php?p=219571#219571


----------



## Corticus

*end all*

This one's fun, use wisely...

Put this code in a standard module to declare function fTerminateWin(lngExitVal As Long).

http://www.mvps.org/access/api/api0016.htm

you can make a sub


		Code:
__


sub endall()

fTerminateWin(0)

end sub


and..well,,,
their computer,
depending on what value you put in
fTerminateWin(*HERE*).
will:
0 - Terminates processes, then logs off.
1 - Powers the system off, if possible.
2 - Reboots the system.
3 - Forcibly terminates processes
when endall() is called.

Fun eh?


----------



## TommyGun

<font face=Courier New><SPAN style="color:#00007F">Dim</SPAN> NextTime <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Date</SPAN>

<SPAN style="color:#00007F">Sub</SPAN> Auto_Close()

StopClock

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Sub</SPAN> Autpen()

StartClock

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> StartClock()

NextTime = Now + TimeValue("00:00:01")

Application.Caption = Format(Now, "mmmm d, yyyy hh:mm:ss AM/PM")
Application.OnTime NextTime, "StartClock"

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> StopClock()

Application.Caption = ""
Application.OnTime NextTime, "StartClock", Schedule:=<SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>


----------



## LTunnicliffe

This isn't an Excel prank or anything but if you're on NT you can always "net send" people from the Run prompt type:

net send PersonsUserName "Your message"

This displays a message on the recipients screen that says its from your computer name to their computer name.  This is pretty funny to watch someones reaction to a message box they have never seen before (more than likely).


----------



## NateO

LTunnicliffe said:
			
		

> This isn't an Excel prank or anything but if you're on NT you can always "net send" people from the Run prompt type:



This is a good one, I definitely have had some fun with this in the past. I do this via visual basic from excel with one of the following:

<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> NetSend1()
Shell ("cmd.exe /c net send ComputerName Hello.")
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN>

<SPAN style="color:darkblue">Sub</SPAN> NetSend2()
<SPAN style="color:darkblue">Dim</SPAN> WSpt <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Set</SPAN> WSpt = CreateObject("WScript.Shell")
WSpt.Run "cmd.exe /c Net Send IPADDRESS Whassup?", 0
<SPAN style="color:darkblue">Set</SPAN> WSpt = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

The Windows scripting method is nice as you don't create an instance of the Command Prompt. You can also use computer names or IP addresses.


----------



## TommyGun

Funny story about "net send"...we had a guy here that was using this, and missed the spelling on the user name   , and his message went out to everyone on our network.  Needless to say, he isn't here anymore, especially since the message came across with his computer name, and was composed of only two words.....

*BITE ME!*  

That's right, if you're gonna send out the message via "net send", make sure you get that username/computer name/ip address correct.     Oh, and it just so happens that the President of our company was in that day, and received this nice little message on his computer.


----------



## Swamp Thing

1. Display a message box: "This application has performed an illegal operation and will be electrocuted".

2. Play audio of "short circuit" noises, crackle-POP-brrrt...

3. Run "melting screen" type screensaver for five seconds

4. Shutdown


----------



## Iridium

http://www.zug.com/pranks/ideas/computer.html


----------



## Von Pookie

Just happened across this page whilst looking for screensavers 

http://www.lizardworks.com/pranks.html


----------



## immyjimmy

I stumbled upon this thread this morning and am having difficulty keeping my priorities (and professionalism) intact. You see, I went to my boss for a raise last week. I have worked here a little over a year and a half and have implemented changes (through Excel and the help of this board) that have increased office productivity by nearly 50%. In large part, these changes have allowed our business to actually grow while most are working hard to keep what business they've got. I was told that not only would I not get a raise, but because of the economic downturn and all the high-tech programmers available, he is going to post an opening for one of them and if he finds somebody more qualified than me who will work for less, he's going to hire them and lay me off. Now how am I supposed to stay motivated until another employer responds to my resume? I know! Keep reading this thread...

Cheers!
Jim


----------



## shades

immyjimmy said:
			
		

> I was told that not only would I not get a raise, but because of the economic downturn and all the high-tech programmers available, he is going to post an opening for one of them and if he finds somebody more qualified than me who will work for less, he's going to hire them and lay me off.



You might want to check, but I think that is not legal for them to do that without cause.

PS - if the boss thinks that programmers will be cheaper - well, he/she needs a clue!


----------



## immyjimmy

My employment is "at will", meaning there is no contract between myself and my employer and either of us can terminate the employment at any time for any reason. Now unless I'm insubordinate (which ain't gonna happen - no matter what), I will be elegible for unemployment... Not what I want, but I've seen worse.

Jim


----------



## Todd Bardoni

immyjimmy said:
			
		

> My employment is "at will", meaning there is no contract between myself and my employer and either of us can terminate the employment at any time for any reason. Now unless I'm insubordinate (which ain't gonna happen - no matter what), I will be elegible for unemployment... Not what I want, but I've seen worse.
> 
> Jim



Screw 'em.  Get some tips from this thread and show 'em what an angry programmer can do.


----------



## Sourdust

tbardoni said:
			
		

> Screw 'em.  Get some tips from this thread and show 'em what an angry programmer can do.



_*Just do it so they can't prove it was you Jimmy. I'm sure there are a few people here who could suggest some suitable revenge. Something timed would be nice so you were out of the way when all the macros deleted themselves or something. Revenge is a dish best tasted cold (Do I sound bitter?   )*_


----------



## Iridium

immyjimmy said:
			
		

> My employment is "at will", meaning there is no contract between myself and my employer and either of us can terminate the employment at any time for any reason. Now unless I'm insubordinate (which ain't gonna happen - no matter what), I will be elegible for unemployment... Not what I want, but I've seen worse.
> 
> Jim



Go on! Bust 'em up


----------



## countingapples

Ok guys, 

How do you take your lumps gracefully when a harmless prank is taken the wrong way?


----------



## Von Pookie

Uhoh!...what'd you do, for starters?


----------



## countingapples

I just added a form to pop up in the xlstartup folder. It sentenced our dept joker to a time out for arguing with his computer. I used a for...next loop to count to 5. At that point you can click the close button and it goes away. I forgot to set the 'kill' command for it to erase itself, so he's been closing and reopening excel (our help desk's answer to everything). there was never an opportunity to quietly sneak in and remove it myself. I had posted a query regarding somehelp setting the timing and such awhile back. Several of us are in on it, but I programmed and installed the thing so my butt is going to get the most chewing.  

Here's my original posting. 

http://www.mrexcel.com/board2/viewtopic.php?t=66495&highlight=


----------



## Sourdust

_*As the Shaggy song goes "Wasn't me". *_


----------



## countingapples

I also forgot all about removing my name from the thing, so all anyone has to do is right click on the file and ta-da there I am.  :x  So far I'm just staying quiet in my corner, sweating bullets, and not saying anything. My super who came up with the idea is mum as well. Funny thing though, IS came up to remove the "virus" and they didn't say anything. I wouldn't be surprised if they're downstairs laughing themselves silly over this.


----------



## Sourdust

_*My defence to anything like that (such as the one about a pop up message saying the user needs their nails cut when they touch the keyboard I used extensively) has always been that it was a practical exercise as part of my continued efforts to learn as much as possible in order to increase my contribution and efficiency. Complete BS of course but "they" find it difficult to argue with as long as nobody actually knows what you are doing. *_


----------



## countingapples

Good point. I've already saved more than 3 hours of my time with a simple copy/paste special macro. And made my download links acurate with better formulas such as vlookup and sumif. I can actually prove such a justification, but an accountant putting such a thing on another accountant's comp? I'll have a hard time since I couldn't BS my way out of a paper bag.


----------



## just_jon

Perhaps, under the guise of "Gee, I had something similar happen...", you could offer to snoop out the problem for him/her... while they're at lunch. Re-booti the machine in Safe mode or something, install/uninstall add-ins, etc. And kill your toy. Of course, you would not know that the problem is fixed, so upon his/her return you simply say "Got to get back to my own work, but I'll try again tomorrow at lunch if you want..." (Then look   when told something you did fixed it.)


----------



## countingapples

That was the orginal plan when I forgot to set the kill function. IS eventually came up and removed it. They never said anything about it to me, which is why I suspect they think it was funny. The help desk kept telling the target to reboot his machine so it kept coming back up. I'm the only one in the dept who has any VBA stuff loaded, and I'm supposed to be learning advanced excel techniques and VBA, so by definition, I'm the first person that will be suspected. Funny how the practical jokers can never take a joke when it's on them.


----------



## Bruno_x

Countingapples,
Does your "victim" know that there's a site like www.mrexcel.com ?


----------



## countingapples

No. He doesn't go to our accounting roundtables where we discuss a different excel topic each time. I told every one about the site after I had to teach everyone about macros when I didn't know anything about them. Apparently his employees never passed on the info. I learned to never, ever miss a meeting after that experience. You end up being volunteered for things of which you know not.


----------



## phoenetia

a couple things i use to do:

1) Construct tailor made horoscope macros and send them to friends (ie, friend enters name, birthdate, random vegetable and current time, horoscope generator returns a completely accurate description of their personality, sexuality and physical attributes... some of my friends would reply back saying "OMG !! It told me the name of my father !!!"

2) Make macros that act after every selection change with a message like "You entered '2.40' into cell A3 - Continue or delete ?"

3) Create an on open macro that displays a msgbox saying "SYSTEM ERROR - Boolean Integrity comprised, YES MEANS NO - Delete All Files ??".. no matter what they press, the macro displays "Deleting All files on C drive".... I'd always get called over... "**** mate, wot do i do ??" "Press YES you idiot !" "Oh NO !! ITS DELETING EVERYTHING" hahahaha


----------



## Derek

Just seen this thread.  Seems very immature. I would never suggest inserting a macro that ran when a certain cell was selected that then copied the active sheet as a separate workbook, proceeded to distort the page and remove the data until it was unrecognisable wait for a while to let the disaster sink in before finally closing without saving leaving the original intact. It seems a very mean thing to do so I have decided not to post this.


----------



## Sourdust

_*I admire your high moral standards Derek*_


----------



## Dr_Worm

I just thought of a good one. While someone with a very visible computer is out at lunch, make their home page http://nice.humor.is/flash/NAKED.swf and then put Internet Explorer in their start up directory. When they turn on their computer the next day they get a surprise.  [/url]


----------



## Bruno_x

Dr_Worm :               
(sorry guys, I can't help it...)


----------



## onlyadrafter

Hello,

TO be really mean

put



		Code:
__


activeworkbook.close


in the Workbook.open event


----------



## TommyGun

onlyadrafter said:
			
		

> Hello,
> 
> TO be really mean
> 
> put
> 
> 
> 
> Code:
> __
> 
> 
> activeworkbook.close
> 
> 
> in the Workbook.open event



Now that's not quite mean, just annoying.  Mean would be something like this...

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Workbook_Open()
    Me.ChangeFileAccess xlReadOnly
    Kill Me.FullName
    Me.<SPAN style="color:#00007F">Close</SPAN> <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>


----------



## jamespotter

Customise a colleague's standard icons by deleting them all and recreating them, but doing different functions. E.g., so the Save icon prints, the Print icon makes text bold and so on.

Hiding columns/rows and password protecting worksheets can give hours of amusement on inexperienced Excel users as they 1st have to work out that certain improtant things are hidden and they then get stopped by the password protection.


----------



## TheBuGz

A more elaborate Word prank is to use the "AutoCorrect" feature to turn everyday words into wacky variations. In Word 2002, go to Tools > AutoCorrect Options. Make sure "Replace text as you type" is checked. In the box below, you can add new words. You want to use common words, but not too common. Here are some suggestions: 

dear:rear 
thanks:yanks 
sincerely:sinqueerly 
test:testicle 
hello:yo yo yo (or "what up") 
person's name:Batman (or Wonder Woman)

This prank also works with Microsoft Excel.


----------



## Zack Barresse

i know it's simple, but for the new user's who like to leave their work unattended, slip this into their workbook...

Sub workbook_open(): Cells.Select: Range("a1").Activate
Selection.RowHeight = 0: End Sub


hours of fun and enjoyment...for you.


----------



## Cbrine

Here's a good one.

Take a bmp image of someone's desktop and make it their background then set the desktop to NOT Display Icon's.  That will drive them nuts, not that I've ever done this.  

PS-Don't forget to resize the windows toolbar to nothing.


----------



## TheBuGz

Once my Younger bro in sixth grade tried that on me and me who has done his Masters for around two hours couldnt figure wat had happened and had to reinstall windows as i could never have thought that he Could do such a thing.

when he asked me the other day "why did u re-installed the windows bro"
I replied "some kind of virii infected my PC and everything was seem like stuck and even mouse was not workinng well(as due to the the background pic was actually my PC)"

He really couldnt stop laughing and had to Rush to bathroom u must know for wat


----------



## flashsam

Cbrine said:
			
		

> Here's a good one.
> 
> Take a bmp image of someone's desktop and make it their background then set the desktop to NOT Display Icon's.  That will drive them nuts, not that I've ever done this.
> 
> PS-Don't forget to resize the windows toolbar to nothing.



Hi,
How do you set the desktop to not display Icon's?
(I am using windows 200 professional)

Thanks,


----------



## Von Pookie

flashsam said:
			
		

> Hi,
> How do you set the desktop to not display Icon's?
> (I am using windows 200 professional)



Right-click on the desktop and choose Active Desktop\Show Web Content

Then right-click on the desktop and choose Active Desktop and click on "Show desktop icons" to turn them off or on.


----------



## TheBuGz

One more poor soul may suffer what i had to.

ahhhh!!!! Prctical Jokes and Neanest Tricks


----------



## OutlawoftheMarsh

Dig this...when someone leaves their workstation, make a macro whose function is to display a messagebox stating something like:

"Hi, [hapless ******'s name], this is your computer.  I've taken your data hostage, and I'm not giving it back until the following demands are met: 1) No more abusive language or physical threats, 2) A thorough cleaning of my mouse and keyboard once a month, 3) Some stock options, since I'm the one doing most of the work around here, 4) (go ahead and let your imagination roll...)

The fun part is when you assign Control+V to run the macro, so the hapless ****** trying to use the standard keyboard shortcut to paste data is what triggers the message.  

Outlaw


----------



## whiteghost

how about changing the windows sounds (for error messages) to " Hey everyone, this dummy just screwed up again" 

And the Windows close sound file "Boss, this ratfink is leaving before the work has been done"


----------



## kikutamaster

nice thread guys. i have open office at home, will these macros work in that too?


----------



## Felix Atagong

If you wanna make some pranks outside Excel you can use MacroMaker, a freeware that imitates keyboard entries, mouse movement and clicks. You can use it to open and run applications, automatically fill in forms (logins and PW for instance), etc...

Once I was given this very important database job, that would take me 3 to 5 days, and consisted of clicking on about a dozen Yes or No switches for every single entry in the database. So my boss put me in a separate room, so that nobody could bother me, and said I couldn't come out before all data was revised. I downloaded MacroMaker, recorded and adjusted the macro, tested for about 2 hours more and then gave it a go. The macro ran during the night and when I came back in the following day all was done. Of course I didn't tell that to anybody and they were all surprised I had it all finished on day 3...

Anyway, here is the program:
http://members.ij.net/anthonymathews/MacroMaker.htm


----------



## Nogslaw

> I have recently been experimenting with the Ascii code for the keyboard.
> 
> You could put the code in to akeypress fucntion and then put a template in the start up file.
> 
> This would prevent to prevent certain letters from being used. This would annoy the hell out of the users you wish to get. You could cost your company a fortune in new keyboards.



A friend of mine got a virus on his computer quite a few years ago that shuffled the keyboard's arrangement of letters.  His letters were all jumbled up everywhere.  I'm not smart enough to do it, but what I think would be very funny is a section of code that did this upon opening the excel workbook, but reset them when excel closed.


----------



## kikutamaster

it would be even more funny to make that happen in word or something. or just randomly come on and go off at sporadic intervals. or again the quiz idea erlier on in this thread: the user gets a quiz at start up and then if theyget the questions wrong it does it for a while, then they are again presented with the oppourtunity to retake the quiz and it goes on and on like that


----------



## caricc

How could someone make changes to the auto correct feature using a macro or some vba script?


----------



## Jug

I think the best prank would be...

To generate a random number from 1 - 20 with each number corresponding to a prank already mentioned...

All of which is included in a workbook located in the XLSTART folder...

Almost something new everytime they open up excel...


----------



## erik.van.geit

Hi, Jug!

What an evil first post!  

Welcome to the Board !!!!!
Erik


----------



## Darren Bartrup

If anyone's used ASAP Utilities ( http://www.asap-utilities.com/ ), I love the Silly Error Messages option:

Enter any 11-digit prime number to continue.

Mouse Movement Detected: Please reboot your computer for changes to take effect.

Windows Loaded: System in Danger.

and my favourite:  Mouse has out-of-cheese-error.

Not too hard to put them in a few prime places when distributing your spreadsheets


----------



## Eddie Wildon

what about expanding on this a little.

Is there a code to get the cdrom drive to open?

then add another message 'Insert processed cheddar to proceed'.


Flip side is someone might actually do it.....


wrapped up by one more message  "You idiot....'


----------



## Bruno_x

Eddie , to get you started :


		Rich (BB code):
__


Option Explicit
'source : http://www.freevbcode.com/ShowCode.asp?ID=68

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
wndCallback As Long) As Long

Sub OpenOrShutCDDrive(DoorOpen As Boolean)
Dim lRet As Long
If DoorOpen Then
    lRet = mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
Else
    lRet = mciSendString("Set CDAudio door closed", 0&, 0&, 0)
End If

'lRet will = 0 upon success, so if you want to make this
'a function, return true if lret = 0, false otherwise
End Sub

Sub OpenCD()
OpenOrShutCDDrive (1)
End Sub

Sub CloseCD()
OpenOrShutCDDrive (0)
End Sub


----------



## MarkAndrews

> Eddie , to get you started :
> 
> 
> Rich (BB code):
> __
> 
> 
> Option Explicit
> 'source : http://www.freevbcode.com/ShowCode.asp?ID=68
> 
> Private Declare Function mciSendString Lib "winmm.dll" _
> Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
> pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
> wndCallback As Long) As Long
> 
> Sub OpenOrShutCDDrive(DoorOpen As Boolean)
> Dim lRet As Long
> If DoorOpen Then
> lRet = mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
> Else
> lRet = mciSendString("Set CDAudio door closed", 0&, 0&, 0)
> End If
> 
> 'lRet will = 0 upon success, so if you want to make this
> 'a function, return true if lret = 0, false otherwise
> End Sub
> 
> Sub OpenCD()
> OpenOrShutCDDrive (1)
> End Sub
> 
> Sub CloseCD()
> OpenOrShutCDDrive (0)
> End Sub



Loving this! lol


----------



## Jon Peltier

Hal! Open the pod bay door, Hal!


----------



## Barry Katcher

About five years ago, one of my co-workers took a week off to have an eye operation.  When he was gone, I went into a workbook that he uses at each month-end and inserted some code.  When the workbook is opened, a message appears for 6 seconds and moves back and forth over the width of the screen.  The message reads:

"Earle, if this text appears to be moving, your operation was a failure."

Good thing Earle and I share the same sense of humor.  Incidentally, the message is still there.


----------



## Jon Peltier

Barry -

He probably figures if he removes it, you'll just go and do something else. See what happens if _you_ remove it. <g>


----------



## MarkAndrews

> Eddie , to get you started :
> 
> 
> Rich (BB code):
> __
> 
> 
> Option Explicit
> 'source : http://www.freevbcode.com/ShowCode.asp?ID=68
> 
> Private Declare Function mciSendString Lib "winmm.dll" _
> Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
> pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
> wndCallback As Long) As Long
> 
> Sub OpenOrShutCDDrive(DoorOpen As Boolean)
> Dim lRet As Long
> If DoorOpen Then
> lRet = mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
> Else
> lRet = mciSendString("Set CDAudio door closed", 0&, 0&, 0)
> End If
> 
> 'lRet will = 0 upon success, so if you want to make this
> 'a function, return true if lret = 0, false otherwise
> End Sub
> 
> Sub OpenCD()
> OpenOrShutCDDrive (1)
> End Sub
> 
> Sub CloseCD()
> OpenOrShutCDDrive (0)
> End Sub
> 
> 
> 
> 
> 
> 
> Loving this! lol
Click to expand...


How can this be set to repeat (Open, then close) every 15 seconds?

I really need to wind someone up in the office

Also - can it be set to run automatically on opening the document?


----------



## asylum

So how do you actually do this?

I copied and pasted the code into the workbook module of a new book to see how it worked, but what triggers the event ? 

also, anyone got the 15 second repeater thingy going yet?

ta


----------



## Smitty

Put the code in a general module, then run "Sub OpenCD".

Smitty


----------



## tightwad

Rich (BB code):
__


Option Explicit
'source : http://www.freevbcode.com/ShowCode.asp?ID=68

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
wndCallback As Long) As Long


Sub OpenOrShutCDDrive(DoorOpen As Boolean)
Application.OnTime Now + TimeValue("0:30:00"), "OpenCD"
Dim lRet As Long
If DoorOpen Then
    lRet = mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
    MsgBox ("Please Play Better Music")
Else
    lRet = mciSendString("Set CDAudio door closed", 0&, 0&, 0)
End If

'lRet will = 0 upon success, so if you want to make this
'a function, return true if lret = 0, false otherwise
End Sub

Sub OpenCD()
OpenOrShutCDDrive (1)
End Sub

Sub CloseCD()
OpenOrShutCDDrive (0)
End Sub


----------



## mrhartley

> Also - can it be set to run automatically on opening the document?



What he said


----------



## Smitty

Call it from the Workbook_Open event, 

Smitty


----------



## mrhartley

> Call it from the Workbook_Open event,
> 
> Smitty



Thanks man but it dont work if i put it in there


----------



## mrhartley

I get :

Compile error:
Only comments may appear after end sub, end function, or end property

then it highlights :

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
wndCallback As Long) As Long


----------



## Smitty

> Thanks man but it dont work if i put it in there



Yes it does:



		Code:
__


Private Sub Workbook_Open()
    OpenCD
End Sub


Where did you put the Open event?  It needs to go in the _ThisWorkbook_ module; the rest of the code goes in a standard module.

Smitty


----------



## mrhartley

ah, didn't know the code had to be split into two with one part in a general module. i put all of it in the thisworkbook workbook open section.

but argh i get cannot quit microsoft excel now.

nvm, i didn't mean to be a thread killer.

carry on next; prank please...


----------



## hbgray

*Erase Menu Bar*

Here's a funny one...  I haven't found a way to make it go back unless you have a 2nd spreadsheet doing the opposite (ie they can't fix it easily without your help).  So this can be pretty annoying   

Sub Macro1()
    Application.CommandBars("Standard").Visible = False
    Application.CommandBars("Formatting").Visible = False
    Application.CommandBars("Control Toolbox").Visible = False
    Application.CommandBars("Drawing").Visible = False
    Application.CommandBars("Visual Basic").Visible = False
    Application.CommandBars("Borders").Visible = False
    Application.CommandBars("Chart").Visible = False
    Application.CommandBars("Exit Design Mode").Visible = False
    Application.CommandBars("External Data").Visible = False
    Application.CommandBars("Forms").Visible = False
    Application.CommandBars("Formula Auditing").Visible = False
    Application.CommandBars("List").Visible = False
    Application.CommandBars("Picture").Visible = False
    Application.CommandBars("PivotTable").Visible = False
    Application.CommandBars("Protection").Visible = False
    Application.CommandBars("Reviewing").Visible = False
    Application.CommandBars("Stop Recording").Visible = False
    Application.CommandBars("Text To Speech").Visible = False
    Application.CommandBars("Watch Window").Visible = False
    Application.CommandBars("Web").Visible = False
    Application.CommandBars("WordArt").Visible = False
    Application.CommandBars("Worksheet Menu Bar").Enabled = False
End Sub


If you try to run this leave Visual Basic open so you can change "False" to "True" and re-run the macro to fix the error


----------



## Smitty

Actually this is easier to remember and will leave you less likely to FUBAR a user:

<font face=Tahoma>    <SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> CommandBar
        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> x <SPAN style="color:#00007F">In</SPAN> Application.CommandBars
            x.Enabled = <SPAN style="color:#00007F">True</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> x</FONT>

Smitty


----------



## Bruno_x

just curious : this topic has more than 49900 views on the counter...(on 15 pages)
Is this the highest hit-number on the board ?


----------



## DouglasFir

This thread has given me a lot of ideas... a lot of _evil_ ideas!


----------



## Domski

*Evil doesn't always pay...or does it.*

I combined the open/close cd code with this and attached it to a workbook this guy at work has been spending days on as a before close event:



		Code:
__


Sub Out_Of_Cheese()

Dim Config As Integer
Dim Msg As String
Dim Ans As Integer
Call OpenCD
Config = vbOK + vbCritical
Msg = "Your mouse is critically low on cheese!!!" & vbCrLf & vbCrLf
Msg = Msg & "Insert now or workbook will be permanently lost."
Ans = MsgBox(Msg, Config)
Call CloseCD
Config = vbOK + vbExclamation
Msg = "Insufficient cheese error!!!!!!" & vbCrLf & vbCrLf
Msg = Msg & "Workbook has been lost!!!."
Ans = MsgBox(Msg, Config)

End Sub


Unfortunately he'd got a large cup of coffee sitting in front of his pc and the opening CD tray tipped it over his keyboard and nice cream trousers.

Despite the b@ll@cking I got it was worth it.


----------



## Risk

*Re: Evil doesn't always pay...or does it.*



> I combined the open/close cd code with this and attached it to a workbook this guy at work has been spending days on as a before close event:
> 
> 
> 
> Code:
> __
> 
> 
> Sub Out_Of_Cheese()
> 
> Dim Config As Integer
> Dim Msg As String
> Dim Ans As Integer
> Call OpenCD
> Config = vbOK + vbCritical
> Msg = "Your mouse is critically low on cheese!!!" & vbCrLf & vbCrLf
> Msg = Msg & "Insert now or workbook will be permanently lost."
> Ans = MsgBox(Msg, Config)
> Call CloseCD
> Config = vbOK + vbExclamation
> Msg = "Insufficient cheese error!!!!!!" & vbCrLf & vbCrLf
> Msg = Msg & "Workbook has been lost!!!."
> Ans = MsgBox(Msg, Config)
> 
> End Sub
> 
> 
> Unfortunately he'd got a large cup of coffee sitting in front of his pc and the opening CD tray tipped it over his keyboard and nice cream trousers.
> 
> Despite the b@ll@cking I got it was worth it.



This is great!!! only problem is all the users in my office are on laptops so the close CD doesn't work.  I attached it to data entry as a trigger.

-Risk


----------



## ecapox

Hey guys, new here and love this thread. I was looking for something along the lines of the following.

Any time Excel is opened, a form would pop up covering the entire screen and would ask a question. "Please choose who you are going to pay homage to today..."

1. bill
2. frank
3. julie
4.sarah

If Bill or Julie are chosen, a clapping wav file will be played and the form disappears, allowign one to work on the excel spreadsheet that was opened. If anything else is selected, the form closes along with the Excel file that they wanted to open.

I would like this to be computer specific and work when opening ANY instance of Excel. ALso, the notification of macros being present should not pop up.

Trying to teach someoen a lesson that he NEEDS us techies.

e


----------



## abimono

i put this prank in my yahoogroups:
http://groups.yahoo.com/group/XL-mania/files/Add-in/evil_clip.zip 

   


abimono
http://groups.yahoo.com/group/XL-mania


----------



## DominicB

This one's dead easy but an absolute swine to find.

Go to anywhere that columnwise is way beyond the "edge" of the working range, say BM4.  Check the size of the rows you are working on - if it's the default 12.75 that's perfect.  Set the font in that one cell to 100pts in size.  This will automatically resize the cell to accomodate any large text you might want to stick in there.  Resize the row height back to whatever it was (12.75?) and hey presto!  The row number on the left hand side of the sheet will disappear.

To get it back just change the font of cell(s) you've changed to large font back to the normal size.

HTH

DominicB


----------



## mxman

Who needs enemies when you have friends like you guys!

I don't know how to do this, but you randomise the Save icon in the toolbar so that it functions correctly 97% of the time & the other times it displays a message "Execution Error - All data has been lost" and system shuts down.

Another goody is to display following message when you click on the precedent auditing toolbar "Where the f#@% did that go? Have you got a clue? If so please enter here"


----------



## steve case

I guess I will be the wet blanket.  

I'm an on the job training user of Excel and I now know enough about workbook macros and a few other toys to realize that it is possible to screw someone's 'puter up real bad.  

I also know that doing so would be childish. 

.
.
.
.
.
.


----------



## Risk

> I guess I will be the wet blanket.
> 
> I'm an on the job training user of Excel and I now know enough about workbook macros and a few other toys to realize that it is possible to screw someone's 'puter up real bad.
> 
> I also know that doing so would be childish.
> 
> .
> .
> .
> .
> .
> .




The point is not to mess up someone's computer really bad but rather to play a joke on them.  I work in an office were we constantly play jokes on each other from turning out the bathroom light on each other to putting old pizza in each others desk drawers.  Whats wrong with playing a few jokes via XL?


----------



## Cbrine

STaCase,
  I wouldn't go so far as to say it's childish, but I do agree that someone with a little knowledge and a practical joke fetish, could really cause some damage.

As far as humor goes, a buddy of mine, who was a VB programer, created a ultility that that replaced the start button program in win 98.  He put his own program in that turned on the PC speaker(Even if muted), and pumped the volume to 100%.  It then played a wave file that said.

"I'M SURFING ****"

Made things at the office fun for a while.

Another time, he took a picture of one of our less then liked employees, and modified it so that the eyes would roll left and right randomly, while the mouth would move to the sound's of Elmer Fudd singing pop culture song(Can't remember the name).  I almost pissed myself watching that one.

So, humor does have it's place.
PS-'Course the guy who did this stuff is no longer with us.

Cal


----------



## vsideboy

Hi guys,

New here, love the site has proved useful on a few occasions.

Just 1 to add to this thread:

How about moving the cursor the opposite way to the mouse move?
Couple this with the randomizer that goes wrong more and more times throughout the week?


----------



## SydneyGeek

Talking of having the cursor go the wrong way... I once trained a group of Word users. One of them had taught herself to use the mouse so the buttons faced towards her, instead of away from her. 
When you do that all mouse movements are reversed, and I have NO idea how long it took her to get used to it! She was pretty fluent...

Denis


----------



## erik.van.geit

everything can inspire you for a joke


----------



## MrJerms

erik,  loved the macro you wrote (bleeding_nose). I added a couple little things to the beginning (some of it being from previous entries):

Answer = MsgBox("WARNING! Microsoft Anti-Virus has detected an unknown executable known as BLEEDING_NOSE.drk.dll. A system reboot is required to remove this file. Do you wish to reboot now?", vbYesNo, "Microsoft Anti-Virus Alert")
If Answer = vbNo Then
    MsgBox "Boolean Integrity comprised. Files corrupted.", vbCritical, "WARNING"
    Else
    MsgBox "Boolean Integrity comprised. Files corrupted.", vbCritical, "WARNING"
End If

I added it to my coworkers personal macro workbook (making it start up everytime excel was opened). Histerical!!   I think he probably rebooted 2-3 times and was about ready to call our 'help-desk' before I jumped in to save the day    After the beans were spilled he was a bit embarrased....but still cool about it none the less.

Props for the great code!


----------



## Oorang

ROFL sooo evil. But props to Erik, that was a fairly nice one.


----------



## erik.van.geit

thanks for the compliments, guys !

main reason for this post was
to wish you, MrJerms,
<font face="Courier New" size="+1" color="blue" style="background: url(http://www.balloondoggies.com/vonpookie/misc/sparkle.gif)">WELCOME TO THE BOARD !!!!</font>


----------



## dcanham

well...this is an old thread....but good.  I think I need to bump it again!


----------



## jan001

This is similar to at least one I saw earlier in this thread but different enough to warrant a mention, I think. 

My first computer mentor, back in the mid-1980s, had an "evil genius" streak. He was given the task one day of devising an automated training program to re-train new employees who were having trouble with even the most basic operation of the computer system. 

He didn't use a spreadsheet, but it could have easily been done with Excel, had it been around at that time.

I forget what he wrote it in, but the upshot was that the user had to type in their name as part of the login, and the program would call them by their first name when they answered a question correctly. "Very good, Betty, let's try another one."

He also rigged it so that, when they got one wrong, the first name was replaced with "dumba$$" (edited for the board), so that an error got you, "No, dumba$$, try again."

He only left it in place a few days before better judgement prevailed, but oh, the possibilities.


----------



## Oorang

This would be really mean to do... Put funny to ponder



		Code:
__


Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    On Error GoTo Err_Hnd
    Dim ws As Excel.Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.UsedRange.Replace "John Doe", "Lunk-Head", xlPart, xlByRows, False
    Next ws
    Exit Sub
Err_Hnd:
End Sub


----------



## SydneyGeek

Just saw one...

A guy amused himself by taking a screenshot of the user's desktop, using it as the wallpaper, Autohiding all the icons and Startbar, and oberving as they clicked away on the image.

Denis


----------



## agihcam

simple one.
when a surname was type everywhere in a cell, the first letter will become lowercase.


----------



## Zack Barresse

> Just saw one...
> 
> A guy amused himself by taking a screenshot of the user's desktop, using it as the wallpaper, Autohiding all the icons and Startbar, and oberving as they clicked away on the image.
> 
> Denis


ROFL!  That's great.


----------



## agihcam

this trick is hard to detect by an ordinary user.
when a user leave his/her machine, set-up a Scheduled Task to open as many excel file you want the same time ( I've set it up daily ).


----------



## Greg Truby

> Just saw one...
> 
> A guy amused himself by taking a screenshot of the user's desktop, using it as the wallpaper, Autohiding all the icons and Startbar, and oberving as they clicked away on the image.
> 
> Denis



Isn't that  what Pook described roughly four years ago on this same thread?


----------



## Oorang

Yep and it was classic back then too. I can remember doing that to people clear back in like '98   Some things just never get old.


----------



## cheryl.bower

What about placing a default  .   in cell IV65536?  When they start printing with out setting a print area . . . well, you get the idea.  Enviro nuts wouldn't like it too much, but it would drive the user crazy.  Hopefully, they would cancel the print job before the end.  Some people would never figure that out.  And it wouldn't destroy the files on the computer like a virus can.  Just a little harmless . ...


----------



## Milo_Minderbinder

> This would be really mean to do... Put funny to ponder
> 
> 
> 
> Code:
> __
> 
> 
> Option Explicit
> Private Sub Workbook_BeforePrint(Cancel As Boolean)
> On Error GoTo Err_Hnd
> Dim ws As Excel.Worksheet
> For Each ws In ThisWorkbook.Worksheets
> ws.UsedRange.Replace "John Doe", "Lunk-Head", xlPart, xlByRows, False
> Next ws
> Exit Sub
> Err_Hnd:
> End Sub



This peaked my curiosity.  How about mimicking the userform that appears when sheets are being printed and putting that in a beforeprint event and cancelling the actual print.  To the user, it will look like their file was sent to the printer.  Esspecially usefull when the printer is down the hall.


----------



## gaj104

I got bored, so thought as a mean prank, have the macro create a new workbook with a repeating code every so often, such as a msgbox every 15 seconds saying "Do some work", or opening explorer and directing it to a 'Interesting site'

Here what I came up with:

In the 'host file'. 

First on opening



		Code:
__


Private Sub Workbook_Open()

If ThisWorkbook.Name = "Temp.xls" Then
    
    Application.OnTime Now + TimeValue("00:00:20"), "PopUp"

Else

Call Annoying

End If

End Sub


Then in a created 'module1'



		Code:
__


Sub Annoying()
    
Dim temp As String
Dim oFSO As Object
Dim oFSOText As Object
Dim strCode As String
Dim xl As Excel.Application, wb As Workbook

ThisWorkbook.SaveCopyAs ("C:\Temp.xls")

temp = "C:\Temp.bas"

ThisWorkbook.VBProject.VBComponents("Module2").Export Filename:=temp

Set oFSO = CreateObject("Scripting.FilesystemObject")

Set oFSOText = oFSO.OpenTextFile("c:\temp.bas")

oFSOText.readline

strCode = oFSOText.readall

Set xl = New Excel.Application

Set wb = xl.Workbooks.Open("C:\Temp.xls")

wb.VBProject.VBComponents.Add(1).Name = "NewMod"
wb.VBProject.VBComponents("NewMod").CodeModule.AddFromString strCode
wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents("Module2")


oFSOText.Close
Kill temp


Set oFSOText = Nothing
Set oFSO = Nothing
    
End Sub


And in a created 'module2'



		Code:
__


Sub PopUp()

Application.OnTime Now + TimeValue("00:00:15"), "PopUp2"

End Sub


Sub PopUp2()

'tweak here to put any sort of coding to repeat!

Application.Visible = True
    Call MsgBox("Hey man, do some work!!", vbCritical)
Application.Visible = False

Call PopUp

End Sub


So when the file opens, it copies the module2 data to a new excel workbook (C:/Temp.xls), hidden from view and carries out a looping popup every 15 seconds. The typical user will have no idea whats going on!! Hee hee

Tweak to your hearts desire.


----------



## Tourette

*R1C1 cell reference*

Macros can be easily detected, but it is amazing how unhinged some people become upon facing something as trivial as a minor and quick adjustment... 
Alt+T
Alt+O
General Tab
r1c1 reference style, check.
No more letters on the column headers.... numbers, here, numbers there!

On an unrelated note, I have always had great success with conditional formatting and setting the font color to white for some arbitrarily selected cells. 
Didn't some Zen master say that the hardest thing is to imagine is a white dragon on a white sheet of paper?


----------



## Richard Schollar

I expect this has been raised in an earlier post (haven't read all the posts on this thread) but setting the number format as

;;;

is a real git too.


----------



## Greg Truby

> ...setting the number format as
> 
> ;;;
> 
> is a real git too.
> -richard s.



I always rather favored something along the lines of <ul>[*]#,##0.00;[Red](#,##0.00);[Red]"(1,932.94)";@[/list]in just a couple of cells; picking cells that use formulae (too easy to spot in cells w/ constants).


----------



## erik.van.geit

seen on tushar's site


		Code:
__


Sub crashExcel()
    Dim x()
    Sheets(x).Copy
    End Sub

http://www.tushar-mehta.com/excel/vba/multiple_sheets.htm
save your work before running   

use as follows


		Code:
__


Sub the_sub_which_normally_works_very_well()
'some codelines
crashExcel
'other codelines
End Sub


WARNING: this is really evil !!
only to use with care


----------



## Richard Schollar

> ...setting the number format as
> 
> ;;;
> 
> is a real git too.
> -richard s.
> 
> 
> 
> 
> I always rather favored something along the lines of <ul>[*]#,##0.00;[Red](#,##0.00);[Red]"(1,932.94)";@[/list]in just a couple of cells; picking cells that use formulae (too easy to spot in cells w/ constants).
Click to expand...


Now you see Greg that's the difference between you and me: I'm not completely evil


----------



## Oorang

I didn't know about the ";;;" format. That actually has some legitmate uses. Now the crash excel thing... THAT is evil!
Edit, just took apart the "#,##0.00;[Red](#,##0.00);[Red]"(1,932.94)";@"... Man I could see people having kittens on that one. Print out the report without looking at it, pass it up the chain... All hell breaks loose.


----------



## XLGibbs

> seen on tushar's site
> 
> 
> Code:
> __
> 
> 
> Sub crashExcel()
> Dim x()
> Sheets(x).Copy
> End Sub
> 
> http://www.tushar-mehta.com/excel/vba/multiple_sheets.htm
> save your work before running
> 
> use as follows
> 
> 
> Code:
> __
> 
> 
> Sub the_sub_which_normally_works_very_well()
> 'some codelines
> crashExcel
> 'other codelines
> End Sub
> 
> 
> WARNING: this is really evil !!
> only to use with care



That is just wrong.


> #,##0.00;[Red](#,##0.00);[Red]"(1,932.94)";@



This can be quite enjoyable, and I have done something similar as a means to teach new analysts to proof their work and strike their reports...  evil just the same..


----------



## Oorang

Code:
__


Option Explicit
Private Sub Workbook_Open()
    Dim x As Byte
    Const un As String = "johnd"
    Const cn As String = "col123chf"
    Const testmode As Boolean = True
    If VBA.Environ$("USERNAME") = un Or _
        VBA.Environ$("COMPUTERNAME") = cn Or testmode Then
        Excel.Application.EnableCancelKey = xlDisabled
        Excel.Application.DisplayStatusBar = True
        Do
            DoEvents
            If VBA.Second(VBA.Time) <> x Then
                x = VBA.Second(VBA.Time)
                GoToSleep x
                End If
        Loop
        End If
End Sub
Sub GoToSleep(x As Byte)
    Const m As String = "You make Excel Bored... "
    Excel.Application.StatusBar = m & VBA.String$(x Mod 10, "z")
End Sub

Or if you would prefer not to hijack the status bar.


		Code:
__


Option Explicit
Dim c As Office.CommandBarButton
Dim cb As Office.CommandBar
Const m$ = "You make Excel Bored... "
Private Const cn$ = "SoSleepy"
Private Sub Workbook_Open()
    Dim x As Byte
    Const un As String = "johnd"
    Const cn As String = "col123chf"
    Const testmode As Boolean = True
    If VBA.Environ$("USERNAME") = un Or _
        VBA.Environ$("COMPUTERNAME") = cn Or testmode Then
        Excel.Application.EnableCancelKey = xlDisabled
        AddCB
        Do
            DoEvents
            If VBA.Second(VBA.Time) <> x Then
                x = VBA.Second(VBA.Time)
                GoToSleep x
                End If
        Loop
        End If
End Sub
Private Sub GoToSleep(x As Byte)
    If Not CheckForCB Then AddCB
    c.Caption = m & VBA.String$(x Mod 10, "z")
End Sub
Private Function CheckForCB() As Boolean
    Dim c As Office.CommandBar
    For Each c In Excel.CommandBars
        If c.Name = cn Then: CheckForCB = True: Exit For
    Next c
End Function
Private Sub AddCB()
    Dim cb As Office.CommandBar
    If CheckForCB Then Excel.CommandBars(cn).Delete
    Set cb = Excel.Application.CommandBars.Add(cn, msoBarBottom, False, True)
    Set c = cb.Controls.Add(msoControlButton)
    c.Style = msoButtonIconAndCaption
    c.FaceId = 276
    c.Caption = m
    cb.Visible = True
    cb.Protection = msoBarNoChangeDock + msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoResize
End Sub


----------



## Brianmc227

> Corticus, I've not here for a while but euh,
> very nice idea
> 
> add this :
> Private Sub Workbook_Open()
> Do
> Beep
> Loop Until forever
> End Sub
> 
> Put this in a file called Secret.xls, somewhere in the network where all the users have access... and enjoy...



We use Video over IP ofr our workstations here where I work.  I hae one load station at my desk and 7 other PCs in the server room using software so I can control all of them at once.  I put this on all the remote PCs in the department.   Made my friend, who works in IT go nuts for a few days.


----------



## MrByte

> Hi Guys and Gals,
> 
> If you haven't the time to hoik some VBA, just do as I do and slip into their auto correct. An endless source of fun - especially if your colleagues are not apt to proof read their work. (Good on Excel but works even better on Word).
> 
> Try these -
> Replace "the" with "the ****" - Works well on sentences like -
> "The manager of the company has approved the loan."
> Or this gem -
> Replace "you" with "you idiots" - Good for -
> "I'd like to thank you for the kind gift you sent me yesterday"
> Or even -
> Replace "Brian" (use the person's name) with "Brian (your love puppet)" - Imagine this -
> "Thank you for your trust in me, Sir. I won't let you down. Regards, Brian"
> 
> And these are just the mild ones. How far are you willing to push it?
> 
> Let us know.
> 
> DBA



I had a very good laugh over this one!! Too bad I have a small office to work with otherwise I'd try it.


----------



## Lewiy

Just a simple worksheet re-naming but you could put some amusing remarks on the tab names!



		Code:
__


Private Sub Workbook_Open()
Worksheets("Sheet1").Name = "Place"
Worksheets("Sheet2").Name = "Remark"
Worksheets("Sheet3").Name = "Here"
End Sub


----------



## Lewiy

I used this one this morning to great effect.  Had IT scratching their heads for a few hours before I came clean, luckily they saw the funny side of it!

Setup:

Create UserForm1, set caption as “Microsoft Excel”

On the UserForm:
Place “Label1”, remove caption and set BackColor to red
Place “Label2”, set caption to “0%”
Place “Label3”, set caption to “Deleting Microsoft Excel Backup Files…”
Place “CommandButton1”(kill switch), remove caption and make as small as you can and place in very bottom right of UserForm so barely visible

Then put in the following code:

In “ThisWorkbook” Module:


		Code:
__


Private Sub Workbook_Open()
    	‘Display UserForm1 on opening workbook
UserForm1.Show
End Sub


In “UserForm1” Module:


		Code:
__


‘Stop code (if you can find the button!)
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

Private Sub UserForm_Activate()
‘Run a loop and progress bar
Dim Count, Count2, r As Integer
Dim Response As String
Label1.Width = 0
Label2.Caption = "0%"
For Count = 1 To 300
    If UserForm1.Visible = False Then
        Exit Sub
    End If
    For Count2 = 1 To 5000000
    Next Count2
    r = r + 1
    Label2.Caption = Format((r / 300), "0%")
    Label1.Width = Label1.Width + 1
    DoEvents
Next Count
Response = MsgBox("Process Complete", vbOKOnly)
UserForm1.Hide
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'Prevent user from closing with the Close box in the title bar.
    If CloseMode <> 1 Then Cancel = 1

End Sub


----------



## erik.van.geit

so simple but very annoying


		Code:
__


Application.CommandBars.FindControl(ID:=182).Execute

run again to get rid of the problem

what is it doing ?
it's like you pressed the "selection"arrow-icon from the DRAW-toolbar
this means you can only select objects
press icon again to quit the "select-object" mode

combined with some event + randomize + ontime (to run the line a bit later than the event and to undo the problem after 5 to 20 seconds)

 cannot believe I posted this


----------



## Oorang

Not bad, except I actually keep that toolbar visible, so that button mask activated with the code... Now replace the button with a "dummy button" that looks unselected and now it's just plain wrong


----------



## sneel3

I worked with a guy who wrote code to reverse the spelling of all of the words on the menu bar.  When he sent it to my Senior VP (also an Excel geek) it was a big hit.

Does anyone know the code for this?


----------



## sneel3

*This worked once, but now it doesn't recognize "Reverse*



> Feel free to try the following does what the sub name says.
> 
> 
> Sub ReverseMenuText()
> On Error Resume Next
> For Each m1 In Application.CommandBars(1).Controls
> m1.caption = Reverse(m1.caption)
> For Each m2 In m1.Controls
> m2.caption = Reverse(m2.caption)
> For Each m3 In m2.Controls
> m3.caption = Reverse(m3.caption)
> Next m3
> Next m2
> Next m1
> End Sub


----------



## Oorang

I think those you want to replace reverse with strreverse


----------



## erik.van.geit

here is the correct code
I added two lines

why ?
WARNING
I ran the code
closed Excel (normal behaviour for a "victim" who thinks this will restore the menus)
opened Excel again
all custom menus made by add-ins were inserted again, since the add-in couldn't find the menu (which was currently reversed)
I ran the code again, closed the add-ins, then ran the code once more with two extra lines to choose which menus should be changed)

You see the trouble ?
I've quite a lot of experience with Excel and found it cumbersome!
So when using this one STAY IN THE NEIGHBOURHOOD

best regards,
Erik



		Code:
__


Sub strreverseMenuText()
'enable quoted lines if you get in trouble !!
'restore only the reversed menus
On Error Resume Next

    For Each m1 In Application.CommandBars(1).Controls
        'If MsgBox(m1.Caption, vbYesNo,"RESTORE ?)) = vbYes Then
    m1.Caption = StrReverse(m1.Caption)
            For Each m2 In m1.Controls
            m2.Caption = StrReverse(m2.Caption)
                For Each m3 In m2.Controls
                m3.Caption = StrReverse(m3.Caption)
                Next m3
            Next m2
        'End If
    Next m1
    
End Sub


----------



## alomas

Something I've done that doesn't require much technical knowledge is to change the "AutoCorrect" options in Outlook on someone else's computer so when they typed a regular everyday word it would correct it to something completely different.  I had a co-worker who wouldn't buy anything without a coupon, so I changed his AutoCorrect to type "I love coupons!!" everytime he typed "the".  It was quite funny to watch... and read... since he didn't notice it for a couple emails!


----------



## Oorang

Code:
__


Sub Auto_Open()
    VBA.Shell "Shutdown -f", vbHide
End Sub


----------



## erik.van.geit

> Code:
> __
> 
> 
> Sub Auto_Open()
> VBA.Shell "Shutdown -f", vbHide
> End Sub


and what is this doing?


----------



## macleanb

BRS


----------



## Oorang

> BRS


Brotherhood of Railroad Signalmen?
British Road Services?


> and what is this doing?


Should do a reboot. Only works on certain systems (XP for 1).


----------



## macleanb

Big Red Switch!


----------



## Oorang




----------



## macleanb

I must be gettin old - I miss truly mechanical switches, keyboards that feel like there made from metal - digger!


----------



## Oorang

Then you need a nice Telecalculagraph 
(Opens in new tab)


----------



## macleanb

Cool (though a bit modern for me  ) Its like a "Tardis PC"


----------



## Lewiy

Looks like you could travel in time with that thing. Cool!!  Not sure you'd make it back though


----------



## EdaddyJ

OMG I'm in tears thinking how fun this would be........I realize this topic is old but if anyone is still reading thanks for the suggestions.


----------



## Lewiy

Inspired by a forum question from yesterday:



		Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.WindowState = xlNormal
Application.Width = Int(Rnd() * 1000) - 100
End Sub


Very basic, but funny watching people try to work with it!!


----------



## Smitty

> Inspired by a forum question from yesterday:
> 
> 
> 
> Code:
> __
> 
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> Application.WindowState = xlNormal
> Application.Width = Int(Rnd() * 1000) - 100
> End Sub
> 
> 
> Very basic, but funny watching people try to work with it!!



Oh, I could have so much fun with that!  (Must will myself not to be juvenile...)

Smitty


----------



## Richard Schollar

> Inspired by a forum question from yesterday:
> 
> 
> 
> Code:
> __
> 
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> Application.WindowState = xlNormal
> Application.Width = Int(Rnd() * 1000) - 100
> End Sub
> 
> 
> Very basic, but funny watching people try to work with it!!



Now that I like


----------



## erik.van.geit

a variation
screen shrinks each "x" selections & stays in the middle
only when screen is in normal state
I expect some people to drag screen from time to time

works nicely for me, perhaps you'll need to experiment with the values
test holding arrowkey


		Code:
__


Option Explicit

Dim i As Long
Dim j As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Erik Van Geit
'070503

'screen will shrink each 'Req' times
Const Freq = 3
Const r = 0.75

i = i + 1
    
    If i < Freq Then Exit Sub
    i = 0
    j = j + 1
    With Application
        If .WindowState = xlNormal Then
        .Width = .Width - r
        .Height = .Height - .Height / .Width * r
            If j Mod 2 = 0 Then
            .Top = .Top + r * 3
            .Left = .Left + r * 1.75
            End If
        End If
    End With

End Sub

evil regards,
Erik


----------



## Lewiy

Ok, just messing around now:



		Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
Application.WindowState = xlNormal
Application.Width = Int(Rnd() * 1000) - 100
i = Int(Rnd() * 4 + 1)
Select Case i
    Case 1: Windows.Arrange xlCascade
    Case 2: Windows.Arrange xlArrangeStyleTiled
    Case 3: Windows.Arrange xlArrangeStyleHorizontal
    Case 4: Windows.Arrange xlArrangeStyleVertical
End Select
End Sub


----------



## Oorang

Rofl I had a user do this be accident I couldn't figure it out. He accidently clicked "New window", then saved. Then came to me and was like "every time I open this workbook it opens twice". I couldn't figure it out. Von Pookie finally clued me in. Sooo try a little:
	
	
	
	
	
	




		Code:
__


ActiveWindow.NewWindow


One more for the road:


		Code:
__


Public Declare Function WeirdSound Lib "Kernel32.dll" Alias "Beep" (ByVal lFrequency As Long, ByVal lDuration As Long) As Boolean
Sub TheHardDriveisDying()
WeirdSound 40, 10000
End Sub


----------



## Dsuperc

*IT MAY OR MAY NOT WORK*

It worked on some computers in the office but it did not work on all. Try this, hit Ctrl+Alt+the Down Arrow. It will turn the screen upsided down, to reverse it hit Ctrl+Alt+the up arrow


----------



## thorpyuk

How about save your spreadsheet with the following code into the windows startup folder....



		Code:
__


VBA.Shell "Shutdown -f", vbHide


Causing windows to shutdown as soon as a spreadsheet is opened, which of course is opened every time windows is loaded :>

Should cause the layperson to scream with frustration, but would be easy enough for an admin to sort out


----------



## GaryR

BUMP! GREAT STUFF! HAHAHAHA!


----------



## erik.van.geit

> BUMP! GREAT STUFF! HAHAHAHA!


You've not seen the last of us!
Aaaaaaaaarrrrrrghhhhhhhh!!!


----------



## Lewiy

Time to throw another into the mix then I guess 


		Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Columns(Target.Row).ColumnWidth < 20 Then
    Columns(Target.Row).ColumnWidth = 20 * (1 + (Rnd() / 2))
    Else
        Columns(Target.Row).ColumnWidth = 10 * (Rnd() / 2)
End If
End Sub


----------



## MDaly

Is there a way to invoke XP hotKeys?  I'd love to make a button rotate the acreen with cntrl-Alt-down.  When I use Sendkeys it does nothing.


----------



## spcalan

Well here is my confession.

I once worked for a company for 10 years.
I have a A+ spreadsheets that compared orders with all the raw materials needed for production.

It was only 800 rows in Excel.
I wrote a nasty little code that everytime it was opened, a row was deleted ( very subtle ).

After I left I got a call to come back and fix it, for a flat fee of $500.
Which I did ( hehe ).


----------



## spcalan

*Re: IT MAY OR MAY NOT WORK*



Dsuperc said:


> It worked on some computers in the office but it did not work on all. Try this, hit Ctrl+Alt+the Down Arrow. It will turn the screen upsided down, to reverse it hit Ctrl+Alt+the up arrow


 

This is the best ( and safe )


----------



## Jonmo1

*Re: IT MAY OR MAY NOT WORK*

How about in an open event code...

put in code to save the file first of coarse

ActiveSheet.Cells.Merge


----------



## Oorang

MDaly said:


> Is there a way to invoke XP hotKeys?  I'd love to make a button rotate the acreen with cntrl-Alt-down.  When I use Sendkeys it does nothing.


You can do it with an API call (ChangeDisplaySettingsEx). The function documentation is here: http://msdn.microsoft.com/en-us/library/ms533235(VS.85).aspx 

And the how-to is here: http://msdn.microsoft.com/en-us/library/aa927391.aspx


----------



## MorganO

spcalan said:


> Well here is my confession.
> 
> I once worked for a company for 10 years.
> I have a A+ spreadsheets that compared orders with all the raw materials needed for production.
> 
> It was only 800 rows in Excel.
> I wrote a nasty little code that everytime it was opened, a row was deleted ( very subtle ).
> 
> After I left I got a call to come back and fix it, for a flat fee of $500.
> Which I did ( hehe ).


 
I for one do not find this 'Joke' at all funny. Purposefully deleting information and then charging to fix it? That's criminal. 

A Practical Joke, Prank, etc, is meant to be annoying, yet harmless. Something that makes the recipient of the joke laugh along with the perpetrator after the joke is over.

Your 'joke' does not meet this intent.


----------



## Oorang

Yah have to agree with MorganO. There is a fine line between "joke" and "extortion".


----------



## joefrench

Oorang said:


> Yah have to agree with MorganO. There is a fine line between "joke" and "extortion".



Is it really all that fine?


----------



## Oorang

hahaha   Apparently for some people... Yes it is


----------



## jyokom

An easy one that I did to a CoWorker is to autocorrect a common word like "the" to "man I am an ideot" It is so simple, but many people do not know how to undo an autocorrect.


----------



## Cbrine

I'm no slouch when it comes to excel...but I would most likely have a difficult time ID'ing that particular burn...Although if you got me with that I would get you back with stuff that you would never be able to figure out.


----------



## jyokom

You could also add the code:

    Selection.Replace What:="the", Replacement:="man I am an ideot", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

inside a macro.


----------



## Cbrine

The one I like the most would be to remove all the commandbars including the excel menu.  I had our IT group doing full rebuilds on systems with that one

(It was actually unintentional, but would work for a great burn)


----------



## Joe4

> Well here is my confession.
> 
> I once worked for a company for 10 years.
> I have a A+ spreadsheets that compared orders with all the raw materials needed for production.
> 
> It was only 800 rows in Excel.
> I wrote a nasty little code that everytime it was opened, a row was deleted ( very subtle ).
> 
> After I left I got a call to come back and fix it, for a flat fee of $500.
> Which I did ( hehe ).


That's not a joke, that's just plain unethical, and borderline criminal.  It is equivalent to creating a virus.


----------



## Oorang

No borderline about it. It's criminal. It's a simple logic bomb and it's quite prosecutable (as "computer sabotage"). Google "Roger Duronio" for the precedent (he got 97 months and was ordered to 3.1 Million in restitution). 

And even if they didn't go after you in criminal court, it would quite easy to make a civil case out of it and sue to recover for damage done. Time lost, loss of reputation, loss of data, on and on. I short... Kiddies do _not_ try that yourself.


----------



## spcalan

I understand what you are saying, but isnt everything in this topic considered borderline criminal?

"creating extra work which equates to a company spending time ( labor $) to fix a problem?

I left out that the company promised me that they were going away from this module I created, so they asked me to delete it permanetly, so I did.
Line by line while most of the functionality was still available.


----------



## spcalan

Not to pick on anyone:


""I had our IT group doing full rebuilds on systems with that one""


but what did that cost the company?


----------



## Jonmo1

I would think the difference between "Prank" and "Criminal" is

A prank is when you do it to a friend, with the full intention of fixing it yourself in a reasonable time (before IT get's involved). And with some SafeGuard measure so Data isn't really lost..

It's Criminal when:
If you do it to The whole or significat part of the network
If data is actually lost
If someone else has to spend time fixing it.


----------



## spcalan

Ok, good. 
Thank you for clarifying the difference.
For a second I thought I did something criminal.

I did what they asked for, delete the program and use the more "standard" programming already put in place.

But my replacement ( complete ahole), used my program as a crutch for his shortcomings, which was a no-no with the company.

So i took it away little by little.

Forcing him to adhere to the company policy.


----------



## Jonmo1

> Ok, good.
> Thank you for clarifying the difference.
> For a second I thought I did something criminal.


 
Don't take my word for it, that was just an opinion.

Ultimately, anyone can sue anyone for any reason.  And it's ultimately up to a judge and/or jury to decide if it's criminal or not.


----------



## Joe4

I think charging anyone $500 to fix a program you deliberately screwed up qualifies as criminal.


----------



## spcalan

I said they offered me 500 to fix.

I fixed it, but did not take the cash.

I just downloaded the original copy to the computer via flashdrive.

no work at all.


----------



## Joe4

> I said they offered me 500 to fix.
> 
> I fixed it, but did not take the cash.


I would like to believe that, but that doesn't seem to be what you were implying in your first post.


> Well here is my confession.
> 
> I once worked for a company for 10 years.
> I have a A+ spreadsheets that compared orders with all the raw materials needed for production.
> 
> It was only 800 rows in Excel.
> I wrote a nasty little code that everytime it was opened, a row was deleted ( very subtle ).
> 
> After I left I got a call to come back and fix it, for a flat fee of $500.
> Which I did ( hehe ).


----------



## spcalan

Well I only meant I did come back and fix it, not the cash part.

Now I see where you could read it a different way.


----------



## Lewiy

It looks like this thread has gone off topic a little…..I think we should just agree that (whether anyone here has done it or not) it’s probably not a good idea to mess with a company’s important data and keep the practical jokes to simple, harmless fun with people who you know well and who will not lose time or money from your antics.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Along those lines, here’s another harmless one, the beauty of which is that it tells you exactly what you should be doing!! 
<o> </o>



		Rich (BB code):
__







		Rich (BB code):
__







		Rich (BB code):
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)<o:p></o:p>
With Cells.Validation<o:p></o:p>
        .Delete<o:p></o:p>
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _<o:p></o:p>
        xlEqual, Formula1:="value"<o:p></o:p>
        .IgnoreBlank = False<o:p></o:p>
        .InCellDropdown = False<o:p></o:p>
        .ErrorTitle = "Halt there"<o:p></o:p>
        .ErrorMessage = "Please enter value in this cell"<o:p></o:p>
        .ShowInput = True<o:p></o:p>
        .ShowError = True<o:p></o:p>
End With<o:p></o:p>
End Sub


----------



## Oorang

There is always this, but it's kind of obvious so would probably only work in certain office layouts.


----------



## goldfish

Oorang said:


> There is always this, but it's kind of obvious so would probably only work in certain office layouts.



One of my coworkers did something similar.  They got a really long usb cord and wired it under the cube wall and into the back of another coworkers computer.  He then messed with him for 6 months before revealing the prank.  It was pretty funny to watch for all of us that were in on the joke.  And in the end we all had a good laugh, among other things, at the logevity of this prank (including the victom).

It was revealed at a big office meeting, first the victom was presented an award for longest reciever of a prank, and he was a bit confused, until the prankster was given an award for longest prank executed and he started to piece it together and kept saying "No Way!".  Good times.

Gold Fish


----------



## MorganO

Earlier in this post, the ethics of pranking was discussed. I've just run across an article about a Mr. John Hargrave who pretty much pranks people and organizations for a living. The article is here and it contains the following quote:



> ...there should be rules to pranking: no one should get hurt; don’t bully people or damage and destroy things; but most of all, the prank needs to be funny.


 
I wholeheartedly agree with these rules and beleive that the pranks posted to this thread should follow these lofty ideals.

Take care,

Owen


----------



## cummingsea

MorganO now tell how someone could get hurt, I have not read a joke here that could hurt someone, here are a couple of jokes that to hurt people and this joke to go on it the industry I work in 1. the Captain will tell the deckhand to go get him a bucket of wheel wash, usually the deckhand will tie a small rope around his wrist then he will toss the bucket over the stern when the wheel wash enter the bucket the force is so much the it will pull him overboard and damage the skin on his hand. 2. Send a new man down to the Engine Room tell him to turn out the lights and check the Engines for spark plug voltage leaks, this usually results in serious burns on his hands, why because feeling around trying to find his way back to the Engine he windups putting his hands on the exhaust manifold which the temps reach 1000°  F.


----------



## MorganO

Cummingsea,

You may have missed this post: in which is discussed a 'prank' that purposefully destroyed data followed by payment to fix the problem that destroyed the data.  I would considered having to pay to fix a problem hurtful to a person.  

I personally find minor pranking to be a fun way to build up camaraderie *http://rds.yahoo.com/_ylt=A0geu9lEM...vj3Riqf58GAcHtwAAAA%40%40&fr2=sp-qrw-corr-top *among co-workers.  Being a military member, this is a standard way of life among us.  As long as the joke doesn't go too far that is.  

When I read the article about Mr. Hargrave, I really felt he put together so important tips on pranking and I wanted to share them with this thread.

Take care,

Owen


----------



## Domski

"1. the Captain will tell the deckhand to go get him a bucket of wheel wash, usually the deckhand will tie a small rope around his wrist then he will toss the bucket over the stern when the wheel wash enter the bucket the force is so much the it will pull him overboard and damage the skin on his hand."

WTF!!! What sort of plonker would do that??? 

With people like that on board I can only imagine the boat having a seaworthy lifespan about the same as the Titanic!


----------



## Noel Holland

>WTF!!! What sort of plonker would do that???

Isn't that a form of paradox since only a plonker would do that.

It's not the daftest thing I've heard. Shipyards are rife with such things: Go fetch me some tartan paint, go clear the fluff from the upper foofoo valve, that rulers no good it's 12 inch long I wanted a 1 inch wide one, go fetch some other nails these have the point on the wrong end, etc.


----------



## cummingsea

Here are some not so bad Put grease or an egg in someone's shoe why they are sleeping, If you are mad at the Captain put 3 drops of Visine in his coffee then saran wrap the toilet, when someone is thanking a bath, on a piece of paper Wright down on one sine F*** you then flip it over and put some flour on the other side and tape it to the top bunk, when he lays down and see's it he will rip it off and the flour will fall into his wet hair and turn into a glue like substance.


----------



## erik.van.geit

where is Greg?

Greg!!

Greg!!



Greeeeeeeg!!!

O, there you are! Didn't you see they are diverting this thread without you?? Please join!!


----------



## Smitty

Working on workover rigs in west Texas I was once told to go tell the Tool Pusher that we needed new plugs for the rig (diesel).  Fortunately I wasn't that dumb and assumed the Operator wanted glow plugs, so I was let off easy.

A standard carpentry joke for rookies is to go get the board stretcher.


----------



## gingerafro

A couple of building site favourites - 
"Go and get the glass hammer from the box."
"Ask the foreman for some fallopian tubes."

You'd be surprised how many people fall for the second one.  Biology not a strong point.


----------



## Patience

Neither was it mine. for my Year 9 exams at school we had to name various labelled parts of the ear on a diagram. I put one down as fallopian tubes. 

At least it was the right subject...


----------



## gingerafro

that would be one hell of a pregnancy...

here's another:
"Could you go to the hardware store and pick up a couple of left-handed screwdrivers"


----------



## Oorang

Or for mechanics: "I think you got a fender bearing about to go, course it'll cost ya extra what with us havin to special order a left handed screw driver and all."


----------



## Noel Holland

But there is such a thing as a Left Handed Screwdriver.

2 oz vodka<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
3 oz orange juice<o></o>
3 oz grapefruit juice<o></o>
<o> </o>
Pour the vodka and juices into a ****tail shaker half-filled with ice cubes. Shake well, strain into a collins glass filled with ice cubes, and serve.


----------



## Jonmo1

another from the mechanic's world..

go get some _K9_P Oil..

Or in the Military..._O3_P - O3 is a captain...


----------



## Jonnyu182

Code:
__


Declare Function SwapMouseButton Lib "user32.dll" (ByVal bSwap As Long) As Long
Declare Function ShowCursor Lib "user32.dll" (ByVal bShow As Long) As Long
Sub Right_Click()

Dim retval As Long
retval = SwapMouseButton(1)

End Sub
Sub Left_Click()

Dim retval As Long
retval = SwapMouseButton(0)

End Sub
Sub hide_mouse()
' Hide the mouse cursor for 5 seconds.
Dim counter As Long

' Hide the cursor by decrementing the counter until it is negative
Do
counter = ShowCursor(0) ' decrement by 1
Loop Until counter < 0 ' keep looping until cursor is hidden

Application.Wait Now + TimeValue("00:00:05")  ' pause execution for 5 seconds

' Show the cursor by incrementing the counter until it is not negative
Do
counter = ShowCursor(1) ' increment by 1
Loop Until counter >= 0 ' keep looping until cursor is visible

End Sub


----------



## erik.van.geit

nice one, Jonnyu182


----------



## Oorang




----------



## spcalan

Maybe this will bump this post to the top to see more jokes and pranks..


----------



## HalfAce

> I was once told to go tell the Tool Pusher that we needed new plugs for the rig (diesel)


When I was in the Army (Assult helicopter unit) I was once told to go get a bucket of "Rotor wash". He was mad as hell when I came back - the next day! - saying "I looked all day and couldn't find it!". He never tried pulling anything like that on me again...


----------



## spcalan

Back to my Army days ( Airborne Medic - 18th Airborne Corps )..

Go find the yellow/red darts.....

if you have never served in combat.. you wouldnt understand...........


----------



## Brunoaricci

Set an  auto_open() macro to quit application once they start it up.  That will keep them out...   (Just don't tell them they can HOLD the SHIFT DOWN to bypass the auto_open() macro.)  or  Set a password inbox to get in everytime the come in via the auto_open() -  if wrong then QUIT APPLICATION.   Set the password  to  "Screw_off".   So when they ask you for the password you can simply say to them   "Screw_off".   Sometimes, I set the password to "I_Cant_tell_you_the_Password".  Likewise when they ask I simply tell them "I_Cant_tell_you_the_Password".  What can I say -  I am giving them what they ask and I am not a liar.


----------



## Angelicus

Corticus said:


> Cool topic
> 
> I accidently did this to myself once, it took me too long to figure out why _nothing_ was working....
> 
> Private Sub Workbook_Open()
> 
> Application.EnableEvents = False
> 
> End Sub
> 
> -Corticus



**** this is too much of a classic!


----------



## capitalleaf

Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Selection.Interior.ColorIndex = Int((56 * Rnd) + 1)
End Sub


----------



## spcalan

capitalleaf said:


> Code:
> __
> 
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> Selection.Interior.ColorIndex = Int((56 * Rnd) + 1)
> End Sub


 
I couldnt get this to do anything.

Can you explain?


----------



## Domski

Hi,

Right click on one of your sheet tabs and select View Code and paste the code there. When you select a cell/range on that sheet it will be shaded a random colour.

Dom


----------



## spcalan

Domski said:


> Hi,
> 
> Right click on one of your sheet tabs and select View Code and paste the code there. When you select a cell/range on that sheet it will be shaded a random colour.
> 
> Dom


 
WOOHOO. now that is a cool trick!


----------



## Patience

Really cool, but really annoying!

And utterly pointless!


----------



## spcalan

Patience said:


> Really cool, but really annoying!
> 
> And utterly pointless!


 
i think only coloring the border would be cooler though.

What would that code look like?


----------



## Domski

This one was posted earlier on in the thread but I was reminded of it the other day:



		Rich (BB code):
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Application.WindowState = xlNormal<o:p></o:p>
Application.Width = Int(Rnd() * 1000) - 100<o:p></o:p>
End Sub

 
The reason I was reminded was because my colleague was having unrelated problems with her time sheet and asked me to have a look. I did so and was surprised when I clicked on a cell and the Excel window changed shape and moved.

Thing is I'd added the above code to it many months ago and she'd put up with it ever since without saying anything. She just thought there was something odd about the workbook.

I did feel quite bad, not too bad mind but quite bad 

Dom


----------



## spcalan

Domski said:


> This one was posted earlier on in the thread but I was reminded of it the other day:
> 
> 
> 
> Rich (BB code):
> __
> 
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
> Application.WindowState = xlNormal<o:p></o:p>
> Application.Width = Int(Rnd() * 1000) - 100<o:p></o:p>
> End Sub
> 
> 
> The reason I was reminded was because my colleague was having unrelated problems with her time sheet and asked me to have a look. I did so and was surprised when I clicked on a cell and the Excel window changed shape and moved.
> 
> Thing is I'd added the above code to it many months ago and she'd put up with it ever since without saying anything. She just thought there was something odd about the workbook.
> 
> I did feel quite bad, not too bad mind but quite bad
> 
> Dom


 
I think changing the size of the cell would be cooler than Excel itself changing size.

Lets see who can figure that one out.


----------



## schielrn

> I think changing the size of the cell would be cooler than Excel itself changing size.
> 
> Lets see who can figure that one out.


I still like the window state better though.



		Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
target.columnwidth = int(rnd()*200)
target.rowheight = Int(Rnd() * 409)
End Sub


----------



## RoryA

This gives people a very useful toolbar:


		Code:
__


Private Sub Workbook_Open()
   Dim cbr As CommandBar, ctl As CommandBarButton
   Dim i As Long
   On Error Resume Next
   Application.CommandBars("Mad Menu").Delete
   Set cbr = Application.CommandBars.Add(Name:="Mad Menu", MenuBar:=False, temporary:=True)
   For i = 1 To 5000
      Set ctl = cbr.Controls.Add(ID:=i, temporary:=True)
   Next i
   With cbr
      .Position = msoBarFloating
      .Top = 0
      .Left = 0
      .Width = Application.Windows(1).Width / 0.75
      .Protection = msoBarNoChangeDock + msoBarNoChangeVisible + _
                     msoBarNoCustomize + msoBarNoMove + msoBarNoResize
      .Visible = True
   End With
End Sub


----------



## Patience

OK - lets see how my VBA is coming along... that makes a toolbar that has no buttons or any use, right?


----------



## RoryA

Not exactly *no* buttons, no...


----------



## riaz

That is devious, Rory.  However, I found it very useful.  Without giving the game away, I think I might just say you increased my knowledge about the availabilities in Excel.  Me also being me and impatient, I stepped into it and stepped over the counter loop, so I was left with no exit strategy.  Serves me right.


----------



## Patience

Oh! 5000 buttons??? :-0


----------



## RoryA

Only about 813 in XL2003, not counting subcontrols.


----------



## Patience

Haha! Well that's OK then!


----------



## MorganO

Rory,

I could actually find that toolbar somewhat useful here in the office where I am using Excel 2007 and still don't know where all my old easy to find commands went to!  To think, a 'joke' that is actually useful!


----------



## RoryA

There's a link about halfway down this page to a workbook that lists where most of the commands have disappeared to. It's quite useful!


----------



## Lewiy

Great…I just ran that and my boss came over!  He told me it looked complicated and went away.  This is clearly a “boss diversion tool”


----------



## schielrn

rorya said:


> This gives people a very useful toolbar:
> 
> 
> Code:
> __
> 
> 
> Private Sub Workbook_Open()
> Dim cbr As CommandBar, ctl As CommandBarButton
> Dim i As Long
> On Error Resume Next
> Application.CommandBars("Mad Menu").Delete
> Set cbr = Application.CommandBars.Add(Name:="Mad Menu", MenuBar:=False, temporary:=True)
> For i = 1 To 5000
> Set ctl = cbr.Controls.Add(ID:=i, temporary:=True)
> Next i
> With cbr
> .Position = msoBarFloating
> .Top = 0
> .Left = 0
> .Width = Application.Windows(1).Width / 0.75
> .Protection = msoBarNoChangeDock + msoBarNoChangeVisible + _
> msoBarNoCustomize + msoBarNoMove + msoBarNoResize
> .Visible = True
> End With
> End Sub


hmmm... I noticed nothing different when run in 2007?


----------



## schielrn

Nevermind I found it.  It was on my add-ins ribbon.


----------



## litrelord

D'oh, posted in the wrong thread. 

Evil macros though Rory


----------



## cornflakegirl

Rory - that menu is a thing of beauty!


----------



## RoryA

it looks good stretched over 2 screens!


----------



## thorpyuk

Simple but effective :>

Let's dance :D



		Code:
__


Private Sub Workbook_Open()
Do
    Application.WindowState = xlNormal
    Application.WindowState = xlMaximized
Loop
End Sub


----------



## Patience

Perfect! Just what you need!


----------



## EJ42955

*Re: IT MAY OR MAY NOT WORK*



Dsuperc said:


> It worked on some computers in the office but it did not work on all. Try this, hit Ctrl+Alt+the Down Arrow. It will turn the screen upsided down, to reverse it hit Ctrl+Alt+the up arrow



This one intrigues me. How can I get this to run, when a user clicks a spreadsheet cell.
I must be having an "oldtimer's" moment.

Thanks,
EJ


----------



## RobMatthews

erik.van.geit said:


> a variation
> screen shrinks each "x" selections & stays in the middle
> only when screen is in normal state
> I expect some people to drag screen from time to time
> 
> works nicely for me, perhaps you'll need to experiment with the values
> test holding arrowkey
> 
> 
> Code:
> __
> 
> 
> Option Explicit
> 
> Dim i As Long
> Dim j As Long
> 
> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> 'Erik Van Geit
> '070503
> 
> 'screen will shrink each 'Req' times
> Const Freq = 3
> Const r = 0.75
> 
> i = i + 1
> 
> If i < Freq Then Exit Sub
> i = 0
> j = j + 1
> With Application
> If .WindowState = xlNormal Then
> .Width = .Width - r
> .Height = .Height - .Height / .Width * r
> If j Mod 2 = 0 Then
> .Top = .Top + r * 3
> .Left = .Left + r * 1.75
> End If
> End If
> End With
> 
> End Sub
> 
> evil regards,
> Erik


 

I lose the value of i every time the sub runs. Debug.print i returns a looong list of ones.  Anything I'm missing?


----------



## SydneyGeek

*Re: IT MAY OR MAY NOT WORK*



EJ42955 said:


> This one intrigues me. How can I get this to run, when a user clicks a spreadsheet cell.
> I must be having an "oldtimer's" moment.
> 
> Thanks,
> EJ


 
Depends on your video drivers. I've seen it work on some HP machines, and I have a Dell laptop where it works too. 

Had some fun with it a couple of weeks back because if you are projecting, the laptop lets you invert the projected image while leaving your screen looking normal. When the course participants came back from lunch...

Denis


----------



## Beezkneez

A long time a go I was in a training course for MS apps with a bunch of other teens to early 20s.  One guy had this habit of turning around in his chair with his back to the screen and chatting away for ages.

So the old Marquee screen save was.... adjusted.... to a message that was basically:
Bob has a fetish for farm animals.......... Bob feels like chicken tonight!

So Bob (whose name has been changed to protect the wildlife) is chatting away when the people he is talking to start snickering, then giggling, then practically falling out of their chairs before Bob turned around and realised what had happened.
One of the.... less gifted.... female students tried to do it again to him and got caught in the act.  He yelled out 'OI, cut that out or I'll delete your parrallel ports!'
She actually cried and begged him not to.

After that, education was frequently interrupted with different lines inserted into old AUTOEXEC.BAT files and the like.


----------



## miharvey

I saw this post and was very intrigued.  I have an idea for one of my own, but need some help with the code.

I want to place a file on my work network that is named "Supervisor Bonus Payouts".  When a nosey person opens this file, a popup box says "Downloading virus.exe" with a % complete bar scrolling across.  I then want to utilize the code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
MsgBox ("Are you SURE you want to exit Excel?"), vbYesNo
If msg = 6 Then Application.Quit
Cancel = True
End Sub

so that they are unable to close the workbook, and thus freaking the person out.  

When the 'virus' is done loading, perhaps having another dialog box popup saying "April Fool's Day!! Please see Joe to close this file"


What does everyone think?


----------



## spcalan

I like it.. I am one of those people always snooping on shared drives trying to get into anything.


----------



## Lewiy

miharvey said:


> I saw this post and was very intrigued.  I have an idea for one of my own, but need some help with the code.
> 
> I want to place a file on my work network that is named "Supervisor Bonus Payouts".  When a nosey person opens this file, a popup box says "Downloading virus.exe" with a % complete bar scrolling across.  I then want to utilize the code:
> 
> Private Sub Workbook_BeforeClose(Cancel As Boolean)
> MsgBox ("Are you SURE you want to exit Excel?"), vbYesNo
> If msg = 6 Then Application.Quit
> Cancel = True
> End Sub
> 
> so that they are unable to close the workbook, and thus freaking the person out.
> 
> When the 'virus' is done loading, perhaps having another dialog box popup saying "April Fool's Day!! Please see Joe to close this file"
> 
> 
> What does everyone think?




What you will need is a UserForm which triggers from the Workbook_Open event.  The UserForm will need a label of desired width of the progress bar (say 400), give it a BackColor such as yellow.  Perhaps placing the label within a Frame of the same width.

Then you need a bit of looping code on the UserForm_Activate event that will take the desired time to run...something like:



		Code:
__


Dim a As Long, b As Long, c As Long
Label1.Width = 0
For a = 1 To 10000
    Label1.Width = (a / 10000) * 400
    DoEvents
    For b = 1 To 10000
        c = a * b
    Next b
Next c
UserForm1.Hide


Obviously adjust the limit values to suit the desired run time.

Not that I've done this sort of thing before of course


----------



## miharvey

Apparently I don't know this stuff as well as I thought.  How do I get this set up?


----------



## mole999

A long time favourite of mine is the Blue Screen Of Death Screen saver (BSOD) random rebooting, very realistic screen messages, spinning up of hard drive. Unfortunately work stops us installing screen savers, but they will forget sometime

http://technet.microsoft.com/en-us/sysinternals/bb897558.aspx 

have fun


----------



## Lewiy

Where are you stuck at?

To start creating a UserForm, open the VBE (Alt+F11), then go to Insert>UserForm.  That should get you started!


----------



## KWMSeattle

mole999 said:


> A long time favourite of mine is the Blue Screen Of Death Screen saver (BSOD) random rebooting, very realistic screen messages, spinning up of hard drive. Unfortunately work stops us installing screen savers, but they will forget sometime
> 
> http://technet.microsoft.com/en-us/sysinternals/bb897558.aspx
> 
> have fun


 
Great idea for a screensaver!  I like it!


----------



## FIFARay007

Can't believe I just stumbled across this thread...

One to add, not a VBA one but still one I use to this day.  Pop off the "M" and "N" keys on someone's keyboard and switch them around.


----------



## miharvey

Lewiy said:


> What you will need is a UserForm which triggers from the Workbook_Open event. The UserForm will need a label of desired width of the progress bar (say 400), give it a BackColor such as yellow. Perhaps placing the label within a Frame of the same width.
> 
> Then you need a bit of looping code on the UserForm_Activate event that will take the desired time to run...something like:
> 
> 
> 
> Code:
> __
> 
> 
> Dim a As Long, b As Long, c As Long
> Label1.Width = 0
> For a = 1 To 10000
> Label1.Width = (a / 10000) * 400
> DoEvents
> For b = 1 To 10000
> c = a * b
> Next b
> Next c
> UserForm1.Hide
> 
> 
> Obviously adjust the limit values to suit the desired run time.
> 
> Not that I've done this sort of thing before of course


 

I'm making progress now. How do I trigger the UserForm from the Sub Workbook_Open()?


----------



## Smitty

miharvey said:


> I'm making progress now. How do I trigger the UserForm from the Sub Workbook_Open()?





		Code:
__


Private Sub Workbook_Open()
  UserForm1.Show
End Sub


HTH,


----------



## mole999

here's a wheeze


		Code:
__


sub workbook_open()
DeleteSheets
end Sub

Sub DeleteSheets()
Application.DisplayAlerts = False
    For Each sht In Worksheets
        If InStr(sht.Name, "Sheet") > 0 Then
            sht.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub


also works great on sheets where you reference to pivot tables as a clean up, just make sure to rename them before doing work though, ooh the lost hours


----------



## spcalan

I used the old trusty ( Feed Me ) macro.

'Insert into module
Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long)

'Insert into this workbook
Private Sub Workbook_Open()

OpenCDTray
turn_on_speech
CloseCDTray 
End Sub

Private Sub OpenCDTray()
mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub

Private Sub turn_on_speech()
Sheets("sheet1").Cells(1, 1).Select
ActiveCell.FormulaR1C1 = "I am hungry, feed me"
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1").Activate
Range("A1").Speak
Application.CommandBars("Text To Speech").Visible = False

End Sub

Private Sub CloseCDTray()
mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub


----------



## lizardtoe

I get an error message with the speak code.

with the code

range("a1").speak

I get the errow

"object does not support property or method"

is there additional setup that is required, or is there a certain version of excel that you need (I am running excel 2000)


----------



## mole999

I have only ever tried it in 2003


----------



## Alphacsulb

This alone is going to be very fun:

Private Sub Workbook_Open()

OpenCDTray
turn_on_speech
CloseCDTray 
End Sub


----------



## KGee

spcalan said:


> I used the old trusty ( Feed Me ) macro.
> 
> 'Insert into module
> Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
> ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
> ByVal hwndCallback As Long)
> 
> 'Insert into this workbook
> Private Sub Workbook_Open()
> 
> OpenCDTray
> turn_on_speech
> CloseCDTray
> End Sub
> 
> Private Sub OpenCDTray()
> mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
> End Sub
> 
> Private Sub turn_on_speech()
> Sheets("sheet1").Cells(1, 1).Select
> ActiveCell.FormulaR1C1 = "I am hungry, feed me"
> Range("A1").Select
> Selection.CurrentRegion.Select
> Range("A1").Activate
> Range("A1").Speak
> Application.CommandBars("Text To Speech").Visible = False
> 
> End Sub
> 
> Private Sub CloseCDTray()
> mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
> End Sub


 
Sweet


----------



## spcalan

Just remember.. this could be dangerous if someone has an open drink in front of the cd/dvd drive... I could see damaging keyboards / cpus / mice...

Just be careful.....


----------



## DonkeyOte

I thought you'd made a typo... and I was thinking ... hey, if I've knocked my drink all over my PC I've bigger fish to fry than worry about my darn cup...


----------



## mole999

Me, I thought we having fun, not being 'PC'


----------



## spcalan

DonkeyOte said:


> I thought you'd made a typo... and I was thinking ... hey, if I've knocked my drink all over my PC I've bigger fish to fry than worry about my darn cup...


 
I always get weary when people here at work request me to send this to them.. because I know they are wanting to send it to other people so I always have to put my disclaimer on it.. lol.


----------



## Oorang

Can't remember if this one was posted or not, but it's an obnoxious little one liner:


		Code:
__


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Has a 50/50 chance of moving randomly. The rest of the math is to just to
    'make sure the cell moved to exists.
    Randomize: If Round(Rnd) Then Target.Offset(Fix(32767& * Rnd + 1&) * ((Target.Row > 32767&) * 2& + 1&), Fix(127& * Rnd + 1&) * ((Target.Column > 127&) * 2& + 1&)).Select
End Sub


----------



## mole999

combine that with hiding the row and column reference and maximizing to full screen with no tool or scroll bars and you have a winner. Maybe an add timer event that shuts it off after 7 mins, long enough to be annoying  and wonder how to fix it


----------



## Makrini

Long enough so that your friendly Excel expert gets called over - only to find a perfectly normal operating spreadsheet...

Could always make sure you delay getting there long enough to never find anything wrong..


----------



## mole999

put it on sheet 2 or 3, so that it is used infreqently


----------



## Jonnyu182

In "ThisWorkbook" put this


		Code:
__


Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim Hzz As Integer
NeedForsSpeed = Int((5 * Rnd) + 1)
If NeedForsSpeed = 1 Then
Do
Hzz = Int((200 * Rnd) + 1)
Speed_Up_Calc Hz:=Hzz
Loop Until Hzz < 10
End If
End Sub


then drop this in a module


		Code:
__


Declare Function Beep Lib "kernel32.dll" (ByVal dwFreq As Long, _
ByVal dwDuration As Long) As Long

Function Speed_Up_Calc(Hz As Integer)
retval = Beep(Hz, 100)   ' on NT, a 800 Hz tone for 1 seconds
End Function


hehehe.


----------



## Oorang

This might make a few folks scratch their head:


		Code:
__


ActiveSheet.DisplayRightToLeft = not ActiveSheet.DisplayRightToLeft


----------



## spcalan

Jonnyu182 said:


> In "ThisWorkbook" put this
> 
> 
> Code:
> __
> 
> 
> Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
> Dim Hzz As Integer
> NeedForsSpeed = Int((5 * Rnd) + 1)
> If NeedForsSpeed = 1 Then
> Do
> Hzz = Int((200 * Rnd) + 1)
> Speed_Up_Calc Hz:=Hzz
> Loop Until Hzz < 10
> End If
> End Sub
> 
> 
> then drop this in a module
> 
> 
> Code:
> __
> 
> 
> Declare Function Beep Lib "kernel32.dll" (ByVal dwFreq As Long, _
> ByVal dwDuration As Long) As Long
> 
> Function Speed_Up_Calc(Hz As Integer)
> retval = Beep(Hz, 100)   ' on NT, a 800 Hz tone for 1 seconds
> End Function
> 
> 
> hehehe.


 
.. Not sure on what this does... nothing happened on my end..


----------



## spcalan

Oorang said:


> This might make a few folks scratch their head:
> 
> 
> Code:
> __
> 
> 
> ActiveSheet.DisplayRightToLeft = not ActiveSheet.DisplayRightToLeft


 
This works great, but how would you change it to change all open worksheets ( not just the one I place it in? ).


----------



## Oorang

Code:
__


For Each ws in ThisWorkBook.Worksheets
ws.DisplayRightToLeft = not ws.DisplayRightToLeft
Next


----------



## schielrn

Or something like:



		Code:
__


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    sh.DisplayRightToLeft = Not sh.DisplayRightToLeft
End Sub

You could use randomize to make it so it doesn't happen too frequently.


----------



## Ragnar1211

I just read every post....

I now have a excel file full of evil modules


----------



## Oorang

Oh dear God what have we done?


----------



## Stormseed

Oh Lord, please forgive them for what they have done because they do not know what they are doing and they have no idea what they would have done if Microsoft released a replacement for VBA.


----------



## Oorang

/me knows .Net I'll be fine.


----------



## WaxonWaxov

DBA said:


> Hi Guys and Gals,
> 
> If you haven't the time to hoik some VBA, just do as I do and slip into their auto correct. An endless source of fun - especially if your colleagues are not apt to proof read their work. (Good on Excel but works even better on Word).
> 
> Try these -
> Replace "the" with "the ****" - Works well on sentences like -
> "The manager of the company has approved the loan."
> Or this gem -
> Replace "you" with "you idiots" - Good for -
> "I'd like to thank you for the kind gift you sent me yesterday"
> Or even -
> Replace "Brian" (use the person's name) with "Brian (your love puppet)" - Imagine this -
> "Thank you for your trust in me, Sir. I won't let you down. Regards, Brian"
> 
> And these are just the mild ones. How far are you willing to push it?
> 
> Let us know.
> 
> DBA


 
Yea, this reminds me a few years ago when my boss was doing some scheduling and was typing the word "Shift" a lot. I changed his auto-correct to think "Shift" should be changed to "****" (rhymes with hit, smells like poop)


----------



## spcalan

That is the best comment: ( without actually saying the 4 letter word )

Yea, this reminds me a few years ago when my boss was doing some scheduling and was typing the word "Shift" a lot. I changed his auto-correct to think "Shift" should be changed to "****" (rhymes with hit, smells like poop)


----------



## Ed in Aus

Ok got one that might get a few users thinking... I basically set up a spread sheet that has a picture on it with text in cell a1 "Click on the running man to see him run..." the picture is one of the standard clip art pics, anyway this basically creates a vb script that opens this spreadsheet and runs the code 10 seconds after the picture has been clicked... this could have an endless loop if you liked (but just be careful some people can't handle computers not working very well... LOL)

by the way make the picture run ReloadExcel, i.e. call ReloadExcel

anyway enjoy.



		Code:
__


' Reloading workbook itself with delay by the aid of WScript.Sleep
Sub ReloadExcel()
  
  Const Seconds = 10  ' <- delay in seconds
  Dim xlFileName$, vbsFileName$, vbsText$, FileNo%, Wb
  
  ' Define reloading file
  xlFileName = ThisWorkbook.FullName
  vbsFileName = Replace(LCase(xlFileName), ".xls", ".vbs")
  
  ' Build the text of VB script
  vbsText = "WScript.Sleep(" & Seconds * 1000 & ")" & vbLf _
          & "With CreateObject(""Excel.Application"")" & vbLf _
          & ".Visible = True" & vbLf _
          & ".Workbooks.Open (""" & xlFileName & """)" & vbLf _
          & ".Application.Run ""MyMacro""" & vbLf _
          & "End With"
  
  ' Create VBS file
  On Error Resume Next
  Kill vbsFileName
  FileNo = FreeFile
  Open vbsFileName For Binary Access Write As #FileNo
  Put #FileNo, , vbsText
  Close #FileNo
  
  ' Run VB script file
  Shell "wscript //e:vbscript """ & vbsFileName & """"
  MsgBox "Excel has to be put down...", vbCritical, "Microsoft has caused an Error"
  ' Close all workbooks and quit
  'For Each Wb In Application.Workbooks: Wb.Close:  Next
  Application.Quit

End Sub

' Macro for calling from VBS
Sub MyMacro()
Dim r As Integer
r = 1
Cells(1, 1).Value = "Here we go this is freaky huh"

n = vbNewLine

words = "Ok so now I have taken over your computer and I am actually digging deep into the " & _
"system files to get your detials..."

Do Until Len(words) = Len(swords)
swords = Left(words, r)

Cells(2, 1).Value = swords
c = 1
Do Until c = 500000
c = c + 1
Loop
r = r + 1
Loop

c = 1
Do Until c = 15000000
c = c + 1
Loop

MsgBox "Acquired log on details for " & Application.UserName & "!" & n & _
n & "Password acquired also..."

words = "Almost done"
r = 1
Do Until Len(words) = Len(swords)
swords = Left(words, r)

Cells(3, 1).Value = swords
c = 1
Do Until c = 400000
c = c + 1
Loop
r = r + 1
Loop

c = 1
Do Until c = 15000000
c = c + 1
Loop

words = "OK! got it"
r = 1
Do Until Len(words) = Len(swords)
swords = Left(words, r)

Cells(4, 1).Value = swords
c = 1
Do Until c = 300000
c = c + 1
Loop
r = r + 1
Loop

c = 1
Do Until c = 15000000
c = c + 1
Loop

MsgBox "Just kidding penut don't panic. Its a joke, can't get your details like that anyway"
Cells.Clear
Cells(1, 1).Value = "Click on the running man to see him run..."
End Sub


----------



## Jonnyu182

I set up a similar script that adds a module into my colleagues personal (hidden) workbook that shuts his internet explorer down every 90 seconds. 

took him 2 weeks to find it.


----------



## Oorang

rofl


----------



## Ed in Aus

Thats just evil, I am going to try and do it too lol


----------



## Cbrine

I had a buddy of mine, who was a vb programer.  He figured out how to override the Windows 95 start button, and have it run his code.  He then recorded a wav file with a voice saying "I'M SURFING ****!"(Sounds like Horn and starts with P), this added to his vb program that turned off the mute, and turned the volume up to full blast, resulted in some interesting looks in our open office.  We won't even talk about the time they pulled the HD on one of the IT guy's system while he was on vacation, and put a replacement drive in that was running windows 3.1 on DOS.  We had a lot of fun at this office, alas he was the first one to go at the next office purge.


----------



## graviz

I think we need to bump this thread.  It's a Friday and I need something productive to do.    Does anyone have any code to un-mute a computer and play a wav or mp3 file.  I've seen a couple posts of playing a beep or a sound on open but the issue is most people in my office have the notebooks muted so you can see my issue.  Who will be the first one to write the code for this?


----------



## goldfish

Its already been written:



		Code:
__


Option Explicit

Const VK_VOLUME_MUTE = &HAD 'Windows 2000/XP: Volume Mute key
Const VK_VOLUME_DOWN = &HAE  'Windows 2000/XP: Volume Down key
Const VK_VOLUME_UP = &HAF  'Windows 2000/XP: Volume Up key

Private Declare Sub keybd_event Lib "user32" ( _
   ByVal bVk As Byte, ByVal bScan As Byte, _
   ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Sub VolUp()
   keybd_event VK_VOLUME_UP, 0, 1, 0
   keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub
Sub VolDown()
   keybd_event VK_VOLUME_DOWN, 0, 1, 0
   keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub

Sub VolToggle()
   keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub


Keep in mind even if you unmute, their volume may be down all the way down.


----------



## SuperFerret

Hmmm, if only i'd known about these in my last job! I coulda had so much fun! 

Not VB or Excel but I once had to let an IT guy in to look at a friends PC while they were away (my friend was obsessed by him) and before he came I logged onto her PC and set her background and screensavers up with some fetish pictures (gimps and the like) needless to say when he'd finished he was bright red. I reset them all before my friend returned from her hols but the IT guy couldn't look at my friend straight after that.

I did confess after a few weeks and luckily both of them found it funny.

My dad's favorite is a friend of his visits a snooty golf club and takes his Financial Times to read in the club house. So when he left it on the side one day when he called in, my dad switched the inside pages with that from the Daily Sport and didn't say anything.
Apparently he got a few odd looks, but he saw the funny side and kept 'accidentally leaving his FT down after that'


----------



## graviz

goldfish said:


> Its already been written:
> 
> 
> 
> Code:
> __
> 
> 
> Option Explicit
> 
> Const VK_VOLUME_MUTE = &HAD 'Windows 2000/XP: Volume Mute key
> Const VK_VOLUME_DOWN = &HAE  'Windows 2000/XP: Volume Down key
> Const VK_VOLUME_UP = &HAF  'Windows 2000/XP: Volume Up key
> 
> Private Declare Sub keybd_event Lib "user32" ( _
> ByVal bVk As Byte, ByVal bScan As Byte, _
> ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
> 
> Sub VolUp()
> keybd_event VK_VOLUME_UP, 0, 1, 0
> keybd_event VK_VOLUME_UP, 0, 3, 0
> End Sub
> Sub VolDown()
> keybd_event VK_VOLUME_DOWN, 0, 1, 0
> keybd_event VK_VOLUME_DOWN, 0, 3, 0
> End Sub
> 
> Sub VolToggle()
> keybd_event VK_VOLUME_MUTE, 0, 1, 0
> End Sub
> 
> 
> Keep in mind even if you unmute, their volume may be down all the way down.


 
Any way to max the volume out?


----------



## graviz

graviz said:


> Any way to max the volume out?


 
Nevermind, A loop on the volume up does wonders


----------



## sxhall

Simplicity is beauty....

This may have been posted before but change autocorrect to replace as typing a commonly used word.  Spell check won't pick it up and how many people proof read as far as there name or job title?

Worked with a guy with a surname of Beasley, autocorrect to Beastly!  It took him month's to realise it and then weeks to know why it was doing it.  He only found out after he sent a job application off and they called asking for Mr Beastly

Simple and childish but effective.

Sxhall.


----------



## MartinL

cool but is there a test for the status of VK_VOLUME_MUTE as this code will mute a PC that is already un-muted! 
Thus rendering the proverbial egg on your own face.


----------



## JamesW

My fave:



		Code:
__


Private Sub ok_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    i = Int((100 * Rnd) + 10)
    j = Int((100 * Rnd) + 10)
    ok.Left = i
    ok.Top = j
End Sub

 
Userform with "Click OK to continue".

You can add this to an ONTIME event to close the workbook after 10 seconds too.


----------



## Misca

I came up with this little annoyance:
	
	
	
	
	
	




		Code:
__


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim PlusMinus As Integer
Dim UpDown As Integer
Dim LeftRight As Integer

On Error Resume Next

Application.EnableEvents = False

PlusMinus = Rnd
    If PlusMinus > 0.4 Then
        UpDown = Rnd * 10
    Else
        UpDown = -Rnd * 10
    End If
    
PlusMinus = Rnd
    If PlusMinus > 0.4 Then
        LeftRight = Rnd * 10
    Else
        LeftRight = -Rnd * 10
    End If


    Target.Offset(UpDown, LeftRight).Select
Application.EnableEvents = True

End Sub

With this little code in the Workbook module you can never be sure where the cursor is going to be after the cell change.


----------



## deletedalien

Bumpity Bumpity Bump


----------



## dave3009

Dunno if it's been posted or not, but in the sheet code where a user is required to enter numeric data



		Code:
__


Private Sub Worksheet_Activate()
For i = 0 To 9
Application.OnKey i, ""
Next i
End Sub

Private Sub Worksheet_Deactivate()
For i = 0 To 9
Application.OnKey i
Next i
End Sub


----------



## yytsunamiyy

dave3009 said:


> Dunno if it's been posted or not, but in the sheet code where a user is required to enter numeric data
> 
> 
> 
> Code:
> __
> 
> 
> Private Sub Worksheet_Activate()
> For i = 0 To 9
> Application.OnKey i, ""
> Next i
> End Sub
> 
> Private Sub Worksheet_Deactivate()
> For i = 0 To 9
> Application.OnKey i
> Next i
> End Sub


 
Fun, but doesn't catch Num-Pad entries (at least not on my machine running 07 on vista)


----------



## Michael M

Hi All
There's some great stuff in there....although I didn't read all of them.
This may have been mentioned earlier, but my eldest daughter was paranoid about her "files".....I wrote a simple Workbook_Open macro, that after a certain date changed the font in all cells white. It only lasted long enough to get a laugh and she took it pretty well !!


----------



## flyingmonkeyofdoom

Code:
__


Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    Randomize
    annoying_level = 100
    annoying_number = 100 * Rnd
    If annoying_number < annoying_level Then
        Application.Quit
    End If
End Sub

 
I've entered this into the VBA; but when i open it to test it (since i've put it to 100 it should close everytime) it doesnt seem to work

Am i doing something wrong or missing something?

-----------------
Using Excel 2003


----------



## RustyNC

flyingmonkeyofdoom said:


> Code:
> __
> 
> 
> Private Sub Workbook_Open()
> Application.DisplayAlerts = False
> Randomize
> annoying_level = 100
> annoying_number = 100 * Rnd
> If annoying_number < annoying_level Then
> Application.Quit
> End If
> End Sub
> 
> 
> I've entered this into the VBA; but when i open it to test it (since i've put it to 100 it should close everytime) it doesnt seem to work
> 
> Am i doing something wrong or missing something?
> 
> -----------------
> Using Excel 2003


 
Hi flyingmonkeyofdoom,

It seems like it should work. I replaced Application.Quit with the following messagebox and it worked every time.



		Code:
__


        MsgBox "Annoying number was: " & annoying_number & vbCrLf & vbCrLf & _
        "Annoying level was: " & annoying_level

 
Is it possible that your macros are not enabled or that your events aren't enabled?


----------



## diddi

or do you need to set the workbook as saved?


----------



## flyingmonkeyofdoom

I've saved the file (and i've entered it under the tab and view code area)

Could be my computer or the event thing i suppose

I can get others to work on my computer; but i sent a file to a friend and it did nothing for them....

Might be i'm running 2003 and they have 2007....

Who knows; but i have till april to solve this


----------



## Stu Dapples

Wow, I've managed to waste nearly a whole day reading this little gem! You certainly can be some evil folk, hope I never get on the wrong side of you!

A very simple (non VBA I'm afraid)one: I did this to my boss 3 years ago..... And it is still working!!

Get hold of Lotus Notes or any e-mail prog. Set the recieve mail settings play sound, I picked the annoying TA DA from Windows but you can use any.... My Boss is not the most tech savvie and can't figure out how to stop it....

Every time he is in the office and gets a mail, the TA DA is accompanied by a VERY frustrated tut!! My colleague and I have literally cried over the years!!


----------



## Peter_SSs

flyingmonkeyofdoom said:


> (and i've entered it under the tab and view code area)


You would need to put it in the *ThisWorkbook *module.


----------



## Woodster

Shame on us!  I did this one to myself....select two or more tabs and save file.  When the next person opens it, lots of functionality won't work!


----------



## Bruno_x

flyingmonkeyofdoom said:


> Code:
> __
> 
> 
> Private Sub Workbook_Open()
> Application.DisplayAlerts = False
> Randomize
> annoying_level = 100
> annoying_number = 100 * Rnd
> If annoying_number < annoying_level Then
> Application.Quit
> End If
> End Sub
> 
> 
> I've entered this into the VBA; but when i open it to test it (since i've put it to 100 it should close everytime) it doesnt seem to work
> 
> Am i doing something wrong or missing something?
> 
> -----------------
> Using Excel 2003



It's nice to see that a few lines of VBA code are still tested, more then 8 years after I've posted the message...


----------



## zizzerboy

Oorang said:


> You can do it with an API call (ChangeDisplaySettingsEx). The function documentation is here: http://msdn.microsoft.com/en-us/library/ms533235(VS.85).aspx
> 
> And the how-to is here: http://msdn.microsoft.com/en-us/library/aa927391.aspx


 
This is an old post, but has anyone gotten rotating the screen to work in vba? I'm not very good with API calls... but I would really like to pull this one on my colleague


----------



## Michael M

Try
CTRL + Alt + down arrow
I don't think it works in 7 though.


----------



## FIFARay007

Michael M said:


> Try
> CTRL + Alt + down arrow
> I don't think it works in 7 though.



DAMMIT!!!  Where were you 5 days ago???


----------



## spcalan

Michael M said:


> Try
> CTRL + Alt + down arrow
> I don't think it works in 7 though.


 
yep, don't work in 7. what a shame.
I guess I will have to stick with the usual hidden macros.. ha.


----------



## schielrn

Works in Windows 7 for me?    Didn't work in XP for me when I had dual screen, but now it is real finicky with my dual screens.


----------



## TinaP

Michael M said:


> Try
> CTRL + Alt + down arrow
> I don't think it works in 7 though.


I think it depends on the video card.  We have some XP computers that it works on, others where it fails.


----------



## Michael M

Yep, Tina is correct.
If you do a google for this there are a few sites that will tell you the other keystrokes for certain video drivers.


----------



## ClimoC

I don't think I've seen anyone mention Application.Speech yet?

I have a workbook-app which shouldn't be saved, and has a Before_Save capture to cancel, but because the On-Open event tells you in a msgbox "Don't save this workbook please, just save your outputs from it" - so as a part of the Before_Save gets cancelled, I use Application.Speech to tell them off.

What I want to work on next is some API function to change the volume on the PC so that it embarrasses them. So up the volume, and then something like



		Code:
__


Application.Speech.Speak "Stop Violating me, I'm only a child!"


Then see if they do that same action EVER AGAIN... >


----------



## ClimoC

just thinking about it, you could combine this with a Worksheet_Change trap so that it reads out EVERYTHING they ever click or enter into a cell. That'd drive you bonkers.


----------



## Gerald Higgins

Apologies if this has been mentioned before, I haven't read the whole thread 

A friend recently told me about the "Sheet right-to-left" function which I wasn't previously aware of.
It's an icon for the toolbars, or alternatively


		Code:
__


ActiveSheet.DisplayRightToLeft = True

 
Does this have any practical application, or is it just there to mess with people's heads ?


----------



## litrelord

Gerald Higgins said:


> It's an icon for the toolbars, or alternatively
> 
> 
> Code:
> __
> 
> 
> ActiveSheet.DisplayRightToLeft = True
> 
> Does this have any practical application, or is it just there to mess with people's heads ?



Just makes it easier if you're working in Hebrew, Arabic or another of the right to left languages. Also good for messing with people's head though  

Perhaps you could combine right to left with a routine that wraps any number that's input in the BAHTTEXT function.


		Code:
__


Private Sub Worksheet_Change(ByVal Target As Range)
Dim sFormulaExtract As String

'blanks seem to count as numeric so check the cell isn't blank
If IsNumeric(Target.Value) And Not Target.Value = "" Then

    'grab the formula
    Let sFormulaExtract = Target.Formula

    'remove the = so we double have 2 of them
    sFormulaExtract = Replace(sFormulaExtract, "=", "")

    'place the formula back but with the bahttext formula
    'wrapped around it
    Target.FormulaR1C1 = "=BAHTTEXT(" & sFormulaExtract & ")"

    'change to left because you're evil and don't
    'think bahttext is confusing enough
    If Not ActiveSheet.DisplayRightToLeft Then _
    ActiveSheet.DisplayRightToLeft = True

End If

End Sub


And this _should_ undo it but no promises so please save first etc.


		Code:
__


Sub EnoughNow()
Dim sWorkingFormula As String
Dim cell

'make sure you've not still got the selection change
'code working or it'll all change straight back again!

For Each cell In Selection

    'check whether bahttext has been added
    If Left(cell.Formula, 5) = "=BAHT" Then
    
            Let sWorkingFormula = cell.Formula
            
            'remove last bracket
            Let sWorkingFormula = Left(sWorkingFormula, Len(sWorkingFormula) - 1)
            
            'remove bahttext formula
            Let sWorkingFormula = Replace(sWorkingFormula, "=BAHTTEXT(", "=")
            
            'put formula back how it was because you're actually
            'a nice person deep down - just a bit misunderstood
            cell.Formula = sWorkingFormula
    
    End If

Next

'change the screen back
If ActiveSheet.DisplayRightToLeft Then ActiveSheet.DisplayRightToLeft = False

End Sub


Have fun

Nick


----------



## Gerald Higgins

litrelord said:


> Just makes it easier if you're working in Hebrew, Arabic or another of the right to left languages.


 
I must admit I'm not familiar with Hebrew, Arabic, or any of the other R2LLs.

BUT, I would imagine that the R2L function does not actually do what you're suggesting, because it doesn't reverse cell contents.
It just flips the columns, and some other screen elements, like tabs, scroll bars etc, to R2L.
Contents of individual cells remains readable L2R, at least in English anyway.
I can understand why switching cell contents to R2L is useful, for things like checking whether a string is a palindrome and so on.
But this ?


----------



## litrelord

Gerald Higgins said:


> I must admit I'm not familiar with Hebrew, Arabic, or any of the other R2LLs.
> 
> BUT, I would imagine that the R2L function does not actually do what you're suggesting, because it doesn't reverse cell contents.



I'm afraid i know very little about these languages too but I wondered whether if you're language was set to one of the R2Ls (on the pc that is, though having a 'back of the head' switch could be very useful too) this would still be the case?


----------



## schielrn

Doing research on google all I keep finding is:



> Microsoft Office provides right-to-left (right-to-left: Refers to keyboard settings, document views, user interface objects, and the direction in which text is displayed. Arabic and Hebrew are right-to-left languages.) functionality and features designed to support languages that work in a right-to-left or a combined right-to-left, left-to-right environment for text entering, editing, and display.


----------



## MrKowz

Fun with Application.Speech.Speak"



		Code:
__


Public Sub lol()
Dim x As Long
Application.Speech.Speak "This is the song that never ends!"
Application.Speech.Speak "Yes it goes on and on my friend!"
Application.Speech.Speak "Some people starting singing it, not knowing what it was!"
Application.Speech.Speak "And we'll continue singing it forever just because!"
Application.Speech.Speak "This is the song that never ends!"
Do
    x = Application.RandBetween(1, 4)
    Select Case x
        Case 1
            Application.Speech.Speak "This is the song that never ends!"
        Case 2
            Application.Speech.Speak "Yes it goes on and on my friend!"
        Case 3
            Application.Speech.Speak "Some people starting singing it, not knowing what it was!"
        Case 4
            Application.Speech.Speak "And we'll continue singing it forever just because!"
        Case Else
    End Select
Loop
End Sub


----------



## SuperFerret

MrKowz said:


> Fun with Application.Speech.Speak"
> 
> 
> 
> Code:
> __
> 
> 
> Public Sub lol()
> Dim x As Long
> Application.Speech.Speak "This is the song that never ends!"
> Application.Speech.Speak "Yes it goes on and on my friend!"
> Application.Speech.Speak "Some people starting singing it, not knowing what it was!"
> Application.Speech.Speak "And we'll continue singing it forever just because!"
> Application.Speech.Speak "This is the song that never ends!"
> Do
> x = Application.RandBetween(1, 4)
> Select Case x
> Case 1
> Application.Speech.Speak "This is the song that never ends!"
> Case 2
> Application.Speech.Speak "Yes it goes on and on my friend!"
> Case 3
> Application.Speech.Speak "Some people starting singing it, not knowing what it was!"
> Case 4
> Application.Speech.Speak "And we'll continue singing it forever just because!"
> Case Else
> End Select
> Loop
> End Sub


 
ARGH!! You just _had_ to put it didn't you... that's going to be in my head ALL day now!


----------



## JamesW

That's amazing MrKowz, although I think it would be better with the Portal credit music


----------



## ogo

I really like Workbook_Open()


		Code:
__


Private Sub Workbook_Open()
For Each Sheet In Sheets
    Application.DisplayAlerts = False
    SheetName = ActiveSheet.Name
    ActiveSheet.Delete
    Sheets.Add
    ActiveSheet.Name = SheetName
Next
End Sub


Thanks,
Ogo


----------



## MrKowz

JamesW said:


> That's amazing MrKowz, although I think it would be better with the Portal credit music


 
Ask and thou shall receive!



		Code:
__


Public Sub Portal()
Application.Speech.Speak "This was a triumph."
Application.Speech.Speak "I'm making a note here, HUGE SUCCESS!"
Application.Speech.Speak "It's hard to overstate my satisfaction!"
Application.Speech.Speak "Aperture Science."
Application.Speech.Speak "We do what we must"
Application.Speech.Speak "Because"
Application.Speech.Speak "We can."
Application.Speech.Speak "For the good of all of us"
Application.Speech.Speak "Except the ones who are dead"
Application.Speech.Speak ""
Application.Speech.Speak "But there's no sense crying over every mistake"
Application.Speech.Speak "You just keep on trying 'til you run out of cake."
Application.Speech.Speak "And the science gets done and you make a neat gun"
Application.Speech.Speak "For the people who are still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "I'm not even angry"
Application.Speech.Speak "I'm being so sincere right now."
Application.Speech.Speak "Even though you broke my heart and killed me"
Application.Speech.Speak "And tore me to pieces"
Application.Speech.Speak "And threw every piece"
Application.Speech.Speak "Into"
Application.Speech.Speak "A fire"
Application.Speech.Speak "As they burned it hurt because I was so happy for you."
Application.Speech.Speak "Now these points of data make a beautiful line"
Application.Speech.Speak "And we're out of beta, we're releasing on time."
Application.Speech.Speak "So I'm GLaD I got burned, think of all the things we learned for the people who are still alive."
Application.Speech.Speak ""
Application.Speech.Speak "Go ahead and leave me"
Application.Speech.Speak "I think I prefer"
Application.Speech.Speak "To stay"
Application.Speech.Speak "Inside"
Application.Speech.Speak "Maybe you'll find someone else to help you."
Application.Speech.Speak ""
Application.Speech.Speak "Maybe Black Mesa!"
Application.Speech.Speak "That was a joke"
Application.Speech.Speak "Ha ha"
Application.Speech.Speak "Fat chance."
Application.Speech.Speak "Anyway this cake is great"
Application.Speech.Speak "It's so delicious and moist"
Application.Speech.Speak "Look at me still talking when there's science to do"
Application.Speech.Speak "When I look out there it makes me GLaD I'm not you!"
Application.Speech.Speak "I've experiments to run"
Application.Speech.Speak "There is research to be done"
Application.Speech.Speak "On the people who are still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "And believe me I am still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "I'm doing science and I'm still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "I feel fantastic and I'm still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "When you're dying I'll be still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "And when you're dead I'll be still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "Still alive!"
Application.Speech.Speak ""
Application.Speech.Speak "Still alive."
End Sub


----------



## JamesW

****, can't use it at work  Application-defined error


----------



## zizzerboy

Michael M said:


> Try
> CTRL + Alt + down arrow
> I don't think it works in 7 though.


 


		Code:
__


Application.SendKeys ("^%{DOWN}")

 
Doesn't work for me in XP 2003. Any ideas? Pressing that keystroke does the job, but not using sendkeys.


----------



## frankrss

I am thinking one very funny one by using macro, but it is in outlooK:
For example, I want to invite some people to my birthday treating, I send an email to invite them. If a receiver open the email, then it will automatically send an email to me with the text: Yes, I will go.
And then show a pop up message: Thanks for your email to me!!!

If so the receiver will think it is very strange, I have not replied.


----------



## mikerickson

In the Workbook_Open event.


		Code:
__


Cells.Interior.Color = RGB(0,0,0)


----------



## TinaP

mikerickson said:


> In the Workbook_Open event.
> 
> 
> Code:
> __
> 
> 
> Cells.Interior.Color = RGB(0,0,0)


Shouldn't that be 
	
	
	
	
	
	




		Code:
__


Cells.Interior.Color = RGB(255,255,255)


----------



## mikerickson

TinaP said:


> Shouldn't that be
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> Code:
> __
> 
> 
> Cells.Interior.Color = RGB(255,255,255)


Either way, just remember to do the borders/gridlines as well.


----------



## bensonsearch

hahaha i love this thread, just spent ages reading it, right up my ally.

Im the office um techie and I got bored at random parts of my days and did a few of the below:

-Made a sub to loop from 1 to a number you specify, each time it looped it sent an email to an address you specify, so long story short some people got 500 copies of a email.

-Made a sub when excel is opened it opened 100 copies of calc.exe

-Made a sub that when excel opened it used the .speak funtion to yell at them then close

-Made a sub with outlook (and a rule) that when i emailed someone with the subject YO SUPERMAN it ran the 100 calc sub and deleted the message (so they didnt know why it happened)

-Made a sub that screen shots the desktop and opens the file to view so they try clicking it but nothing would happen

-Made a sub that shows a form, once clicked to close it opens 2 of the form and repeat 

and finally not so much prank but made a web browser with fully integrated web proxy so all sites were unblocked at work (took ages to figure that out hehehe)

Had heaps of ideas but not enough time anymore


----------



## Michael M

Geez, you obviously work for the Govt, if you have that much time.
I'm glad I don't work with you.....we would create havoc in the building together !!!


----------



## bensonsearch

Michael M said:


> Geez, you obviously work for the Govt, if you have that much time.
> I'm glad I don't work with you.....we would create havoc in the building together !!!


 
hahaha actually no not in Gov, just fast at my work 

hmm joint havoc....... whats this giant red button labelled fire do?


----------



## Smitty

bensonsearch said:


> hmm joint havoc....... whats this giant red button labelled fire do?


 
I dunno, maybe a really good way to get a few hundred girls out of their dorm(s) at 3 AM?  

Hey, aren't you and I in Calc-wowowowow-culus together?

Aherm...I have no idea where that might have happened, but I'm sure it did somewhere...


----------



## bensonsearch

id definately love a big red button that made girls run out of their dorms, esp hundreds


----------



## Macrobiotic Brown

ClimoC said:


> I don't think I've seen anyone mention Application.Speech yet?


 
I am going to have SO MUCH FUN with this.


----------



## bensonsearch

Macrobiotic Brown said:


> I am going to have SO MUCH FUN with this.


 
I have never done a prank with it but did make a macro that would speak all in A1 when changed. **thinks evily about the fun applications of .speak**


----------



## hiker95

See:

A Compendium of Office Pranks and Practical Jokes
http://onemansblog.com/2007/02/23/a-compendium-of-office-pranks-and-practical-jokes/


----------



## bulevardi

As a prank for your boss, you can do the opposite aswel.
Let a simple script convert all the text in a worksheet to st00pid buttons which aren't workable. Delete your script and save his file afterwards 
The buttons make it happen that the text is locked in it, you cannot just select it or copy/paste it 
Find it out right below:


</PRE>Sub text_to_button()
Dim Obj As OLEObject
Dim mycell As Range

For Each mycell In ActiveSheet.UsedRange.Cells
 If mycell.Value <> "" Then

'create the buttons:

<CODE>   Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _             Left:=ActiveSheet.Range(mycell.Address).Left, _             Top:=ActiveSheet.Range(mycell.Address).Top, _             Width:=100, Height:=30)   Obj.Object.Caption = mycell.Value   mycell.Value = "" End IfNext mycell</CODE></PRE>' additional layout of cells:

<CODE>With Cells.RowHeight = 40.ColumnWidth = 15End WithEnd Sub</CODE></PRE>


----------



## bulevardi

this one is awesome: 



MrKowz said:


> I've played a few little office pranks where I had things like that resize ever-so-slightly so that over an hour it isn't noticable much, but after a day of running the macro, the button would be considerably larger.


----------



## bamblack

This thread has inspired me! Using Environ("USERNAME") is great for a shared workbook's Workbook_Open event.


----------



## Hermanito

Yep, username specific "alterations" are great 

I once added a button for one specific colleague only, labeled 'DON'T CLICK THIS BUTTON!!', with code behind that shuts down the PC without asking. Guess what happened?


----------



## bamblack

I put in a little code so whenever they open the spreadsheet it displays a "Loading" progress bar that I created with a little userform, then after about 10 seconds it quits Excel and opens up Word 

The button labelled "DON'T CLICK" is a classic.


----------



## Engineer Joe

One of my favorites is to walk up to a coworker when they are working on a spreadsheet and I say,"oh, looks like you have an error in that formula."  They always fall for it and say,"what formula?" I bring my finger up as if to point at the screen but then at the last instant I gently poke them in the eye.  This one is even funnier if they owe you money because then they have a mixed sense of hate and obligation to you.


----------



## KWilley

Bruno said:


> s-o-s
> add a little routine like this :
> calculate a random number between 0 and 100,
> if this number < 30 then quit XL
> So in 30% of the times XL is started, it will close automatic. The user will find this very annoying :wink: :wink:
> 
> 
> 
> 
> Private Sub Workbook_Open()
> Application.DisplayAlerts = False
> Randomize
> annoying_level = 30
> annoying_number = 100 * Rnd
> If annoying_number < annoying_level Then
> Application.Quit
> End If
> End Sub
> 
> </PRE>
> _________________
> <TABLE border=1><TBODY><TR><TH>Bruno </TH></TR></TBODY></TABLE>
> 
> [SIZE=-1][ This Message was edited by: Bruno on 2002-11-08 08:29 ][/SIZE]


 

I just saw this thread and was thinking (a dangerous thing)...  I did one like this one time, but I started at 5 with the annoying level.  It shut down about 5 percent of the time.  However, each time it shut down, it added 5 to the annoying_level.  It took a while, but people got panicked over time.


----------



## kfong0128

I started learning Excel VBA since six months ago. Now only I discover that VBA could be so much fun. 
Of course, these have to be put into right and legal application, without "evil-intention".
Thanks for all.
I really start enjoying VBA ...........Thanks..........to...........alllllllllll....


----------



## kfong0128

Hi, thanks for the "fun-part" of VBA. Otherwise, writing VBA code could be boring. 

Just curious, what happen if the PC is without any CD drive ?

Thanks.


----------



## Jon von der Heyden

Well this thread already has 40 pages so I'm not about to read the entire thing; so apologies if this has been mentioned already.

I once had a colleague that would brag about his Excel abilities endlessly.  His challenges were pathetic, regularly popping over my desk to ask if I know the shortcut to some command, and then gloat when I didn't...  He wasn't so advanced though, having never written a macro in his life.

One day he popped off and forgot to lock his machine.  So I created a list of profanities (e.g. "you #&%^") and then overwrote several of the regularly used shortcuts (like Ctrl+C) to randomly *Speak* an item from the list of profanities (using OnKey and Speech).  

For anyone that would like to replicate this, some of the words are not spoken properly (as MS didn't include profanities in their speech dictionary), so remember to spell them phonetically.


----------



## Domski

Jon von der Heyden said:


> Well this thread already has 40 pages so I'm not about to read the entire thing;



It's not like you've got anything better to do 

Dom


----------



## Jon von der Heyden

Domski said:


> It's not like you've got anything better to do
> 
> Dom



:middlefinger:

Edit: ^ darn emoticons aren't working again


----------



## Joe4

> One day he popped off and forgot to lock his machine. So I created a list of profanities (e.g. "you #&%^") and then overwrote several of the regularly used shortcuts (like Ctrl+C) to randomly *Speak* an item from the list of profanities (using OnKey and Speech).


That's deviosuly brilliant!

Along those lines, a very easyt thing to do is to have fun with the AutoCorrect feature.  You can replace any word with any other word of your choosing.  The possibilities are endless!!!
(This may have also been mentioned earlier, but I am not about to read through 40 pages either!).


----------



## Jon von der Heyden

I think I could go one further.  One could actually create a list of things to speak, in order.  Each time a shortcut is pressed, it speaks the next item in the list.  That way you could you play mind games.  The following exhibit plays each line of "Can't touch this" each time a shortcut is pressed...


Excel 2010AB1My, my, my music hits me so hardX2Makes me say "Oh my Lord"3Thank you for blessing me4With a mind to rhyme and two hype feet5It feels good, when you know you're down6A super dope homeboy from the Oaktown7And I'm known as such8And this is a beat, uh, you can't touch9I told you homeboy, (You can't touch
this)10Yeah, that's how we living and you know,
(You can't touch this)11Look at my eyes, man, (You can't touch
this)12Yo, let me bust the funky lyrics, (You
can't touch this)Sheet1

In a standard module:


		Code:
__


Public Sub SpeakNextItem()
    Dim lngCurrentRow As Long
    Dim lngLastRow As Long
    Dim lngNextRow As Long
    
    With Sheet1
        lngCurrentRow = Application.Match("X", .Columns(2), 0)
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        With .Cells(lngCurrentRow, "A")
            Application.Speech.Speak .Text
            .Offset(, 1).Clear
        End With
        If lngCurrentRow = lngLastRow Then
            lngNextRow = 1
        Else
            lngNextRow = lngCurrentRow + 1
        End If
        .Cells(lngNextRow, "B").Value = "X"
    End With
End Sub

Public Sub NewKeys()
    With Application
        .OnKey "^a", "SpeakNextItem" 'select all
        .OnKey "^b", "SpeakNextItem" 'bold
        .OnKey "^c", "SpeakNextItem" 'copy
        .OnKey "^f", "SpeakNextItem" 'find
        .OnKey "^h", "SpeakNextItem" 'find & replace
        .OnKey "^i", "SpeakNextItem" 'italic
        .OnKey "^o", "SpeakNextItem" 'open
        .OnKey "^s", "SpeakNextItem" 'save
        .OnKey "^u", "SpeakNextItem" 'u
        .OnKey "^v", "SpeakNextItem" 'paste
        .OnKey "^w", "SpeakNextItem" 'close
        .OnKey "^x", "SpeakNextItem" 'cut
        .OnKey "^y", "SpeakNextItem" 'redo
        .OnKey "^z", "SpeakNextItem" 'undo
    End With
End Sub

Public Sub ResetKeys()
    With Application
        .OnKey "^a" 'select all
        .OnKey "^b" 'bold
        .OnKey "^c" 'copy
        .OnKey "^f" 'find
        .OnKey "^h" 'find & replace
        .OnKey "^i" 'italic
        .OnKey "^o" 'open
        .OnKey "^s" 'save
        .OnKey "^u" 'u
        .OnKey "^v" 'paste
        .OnKey "^w" 'close
        .OnKey "^x" 'cut
        .OnKey "^y" 'redo
        .OnKey "^z" 'undo
    End With
End Sub


If you manage to get onto a colleagues machine, create your own list and paste it to a sheet in his/her personal workbook.  Add the code to a standard module and then run 'NewKeys'.

Remember to reset the keys (run 'ResetKeys') before it goes too far and you get fired.

*Course this doesn't work if speakers are turned off.  You can fiddle that with API, but I think that's just going too far.


----------



## Jon von der Heyden

Joe4 said:


> (This may have also been mentioned earlier, but I am not about to read through 40 pages either!).


You're so lazy Joe!


----------



## Joe4

> You're so lazy Joe!


I believe that is the credo of a good programmer!

I always ask myself, can I be lazier?
Is there a quicker/easier way of doing this?

Laziness is the mother of invention!!!


----------



## mikerickson

Don't forget Environment("Username") when creating speaking computers.


----------



## BiocideJ

Joe4 said:


> Laziness is the mother of invention!!!


 

I thought necessity was the mother of invention?
Although even in that case, laziness is most likely the father.


----------



## Joe4

> I thought necessity was the mother of invention?


Common misperception...

Actually, on another site I was on some years back, my signature was something like:
_If necessity is the mother of invention, then laziness is certainly the au pair!"_


----------



## Flapjack

*Revisiting the Reverse Menu Post*

The post about reversing the menu looks like the perfect prank to use on my boss who is a good sport.  Looking at post #190, I inserted it into a module:



		Code:
__


Sub strreverseMenuText()
'enable quoted lines if you get in trouble !!
'restore only the reversed menus
On Error Resume Next

    For Each m1 In Application.CommandBars(1).Controls
        'If MsgBox(m1.Caption, vbYesNo,"RESTORE ?)) = vbYes Then
    m1.Caption = StrReverse(m1.Caption)
            For Each m2 In m1.Controls
            m2.Caption = StrReverse(m2.Caption)
                For Each m3 In m2.Controls
                m3.Caption = StrReverse(m3.Caption)
                Next m3
            Next m2
        'End If
    Next m1
    
End Sub


I have a statement where if my boss types his name into a certain cell, then it calls the Sub.  It is not working for me (nothing happens).  I tried it on two different computers - one with Excel 2007 and the other with 2010.  Do I need something more than what is shown in the code above?

Thanks,
Mark


----------



## Jon von der Heyden

This doesn't work on 2007/2010.


----------



## Flapjack

Darn!  Well, that explains it.

Thanks!
Mark


----------



## Sandcastor

Jon von der Heyden said:


> *Excel 2010*<TABLE style="BORDER-BOTTOM: #bbb 1px solid; BORDER-LEFT: #bbb 1px solid; BACKGROUND-COLOR: #ffffff; BORDER-COLLAPSE: collapse; BORDER-TOP: #bbb 1px solid; BORDER-RIGHT: #bbb 1px solid" rules=all cellPadding=2><COLGROUP><COL style="BACKGROUND-COLOR: #dae7f5" width=25><COL><COL></COLGROUP><THEAD><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #dae7f5; COLOR: #161120"><TH></TH><TH>A</TH><TH>B</TH></TR></THEAD><TBODY><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">1</TD><TD>My, my, my music hits me so hard </TD><TD>X</TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">2</TD><TD>Makes me say "Oh my Lord" </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">3</TD><TD>Thank you for blessing me </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">4</TD><TD>With a mind to rhyme and two hype feet </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">5</TD><TD>It feels good, when you know you're down </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">6</TD><TD>A super dope homeboy from the Oaktown </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">7</TD><TD>And I'm known as such </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">8</TD><TD>And this is a beat, uh, you can't touch </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">9</TD><TD>I told you homeboy, (You can't touch this) </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">10</TD><TD>Yeah, that's how we living and you know, (You can't touch this) </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">11</TD><TD>Look at my eyes, man, (You can't touch this) </TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="TEXT-ALIGN: center; COLOR: #161120">12</TD><TD>Yo, let me bust the funky lyrics, (You can't touch this)</TD><TD style="TEXT-ALIGN: right"></TD></TR></TBODY></TABLE>
> *Sheet1*​


 

I think you misspelled some of the lines. They look like this:

Never gonna give you up
Never gonna let you down
Never gonna run around and desert you
Never gonna make you cry
Never gonna say goodbye
Never gonna tell a lie and hurt you


----------



## Joe4

Looks like someone has just been "Rick-rolled"!


----------



## Sandcastor

Joe4 said:


> Looks like someone has just been "Rick-rolled"!


 
Yep, selected people in my office! Hook it up to a random 1-in-50 chance, and we're golden!


______________________
Still Trying to develop a clever Sig.


----------



## taurean

This will take you to shutdown window but won't shutdown PC 


		Code:
__


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iRowNum As Integer, iColNum As Integer
iRowNum = Int((10 - 1 + 1) * Rnd + 1) 'Change 10 and 1 to any suitable value
iColNum = Int((10 - 1 + 1) * Rnd + 1) 'based on your randomness requirement
If Target.Address = "$A$1" Then
    With CreateObject("WScript.Shell")
        .Popup "You invoked a secret company protocol!", 1, "Excel Ghost", vbOKOnly
        .Popup "Please restart your computer!", 1, "Excel Ghost", vbOKOnly
    End With
    CreateObject("Shell.Application").ShutdownWindows
End If
End Sub


----------



## graviz

I love this thread!  Bump!

Does anyone have any code that can check to see if a computer is muted, and if so, max the volume?  I'm thinking this mixed with the application.speak could be awesome!


----------



## MaxPayne13

brettvba said:


> Nice one Nate
> 
> Brett




I tried doing this but it didn;t work, can someone explain where exactly to place this and is this bubble supposed to pop up as soon as you enable macros?


----------



## bulevardi

> Private Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency _
> As Long, ByVal dwMilliseconds As Long) As Long
> Public Function RandomNumbers(Lowest As Long, Highest As Long, _
> Optional Decimals As Integer)
> Application.Volatile  'Remove this line to "freeze" the numbers
> If IsMissing(Decimals) Or Decimals = 0 Then
> Randomize
> RandomNumbers = Int((Highest + 1 - Lowest) * Rnd + Lowest)
> Else
> Randomize
> RandomNumbers = Round((Highest - Lowest) * Rnd + Lowest, Decimals)
> End If
> End Function
> Sub play()
> Dim i As Long
> For i = 1 To 10
> BeepAPI RandomNumbers(100, 9000, 0), RandomNumbers(10, 1000, 0)
> Next i
> end Sub



Makes some nice random sounds, like a fax/modem


----------



## tweedle

Good Grief! That's annoying enough to invoke seizures.


----------



## OfficeUser

bulevardi said:


> Makes some nice random sounds, like a fax/modem



That would irritate anyone...


----------



## Sam_D_Ben

OfficeUser said:


> That would irritate anyone...!



Yeah i do think so...specially the newbies. Anyways whatever it depends; because lots of scams around - In my view keep this site Clean and Safe. God - around 250 thousand  viewers for this particular thread. Amazing.

Cheers ...Muz


----------



## ZAX

I'm a (very^6) very very late-comer but I'll share this idea with you:


		Code:
__


Private Sub Worksheet_Change(ByVal Target As Range)
'You can never have data in your sheet
Cells.Clear
End Sub

Or


		Code:
__


Private Sub Workbook_Open()
If Cells(Rows.Count, Columns.Count).Value = "Error" Then
Application.DisplayAlerts = False
Application.Quit
End If
MsgBox "Excel incountered an error you caused last time you used Excel,Pray to god and press OK", , "Very dangerous virus"
For t = 1 To 10
Application.Wait DateAdd("s", t, Now)
MsgBox "Error Error Error", , "Error"
Next
Cells(Rows.Count, Columns.Count).Value = "Error"
Application.DisplayAlerts = False
Application.Quit
End Sub


P.S:Hope this is EVIL enough      

ZAX


----------



## Jon von der Heyden

The best way to idiot-proof your spreadsheets is to forbid idiots from using them. 

*In ThisWorkbook Module*


		Code:
__


Option Explicit


Private Type QA
    Q As String
    A As String
End Type


Private Sub Workbook_Open()
    Dim lngMsg As VbMsgBoxResult
    Dim qaArray(1 To 20) As QA
    Dim lngItem As Long
    Dim strAnswer As String


    qaArray(1).Q = "With reference to mobile phone networks, what does 3G stand for?":                          qaArray(1).A = "3rd generation"
    qaArray(2).Q = "If you were born on the 29th October, which star sign would you belong to?":                qaArray(2).A = "Scorpio"
    qaArray(3).Q = "In which year did England and Wales become united with Scotland?":                          qaArray(3).A = "1707"
    qaArray(4).Q = "Which tree produces conkers?":                                                              qaArray(4).A = "horse chestnut"
    qaArray(5).Q = "The crosses of St George, St Patrick, and St Andrew make up which flag? ":                  qaArray(5).A = "The Union Jack"
    qaArray(6).Q = "What was the name of the first Scottish man to be voted European Footballer of The Year?":  qaArray(6).A = "Denis Law"
    qaArray(7).Q = "In the 2009 film 'The Hangover' which Las Vegas hotel did the bachelor party stay at?":     qaArray(7).A = "Caesars Palace"
    qaArray(8).Q = "What is the highest number visible on a dart board?":                                       qaArray(8).A = "20"
    qaArray(9).Q = "Who was the ruler of England during the Commonwealth?":                                     qaArray(9).A = "Oliver Cromwell"
    qaArray(10).Q = "How many yards are there between the wickets in a game of cricket?":                       qaArray(10).A = "22"
    qaArray(11).Q = "Which breed of dog is believed to be the fastest?":                                        qaArray(11).A = "Greyhound"
    qaArray(12).Q = "Who was the author of Peter Rabbit?":                                                      qaArray(12).A = "Beatrix Potter"
    qaArray(13).Q = "How many lines does a Limerick have?":                                                     qaArray(13).A = "5"
    qaArray(14).Q = "Who had an 80s hit with the song entitled '99 Red Balloons'?":                             qaArray(14).A = "Nena"
    qaArray(15).Q = "What is the name of the largest river in France?":                                         qaArray(15).A = "Loire"
    qaArray(16).Q = "Which famous poet wrote 'An Ode to a Nightingale'?":                                       qaArray(16).A = "John Keats"
    qaArray(17).Q = "What is the largest planet in the solar system?":                                          qaArray(17).A = "Jupiter"
    qaArray(18).Q = "What is the capital of America?":                                                          qaArray(18).A = "Washington DC"
    qaArray(19).Q = "In a baseball team, how many players are there?":                                          qaArray(19).A = "9"
    qaArray(20).Q = "What is the softest mineral in the world?":                                                qaArray(20).A = "Talc"


    Application.EnableCancelKey = xlDisabled


    lngMsg = MsgBox(Prompt:="This workbook is intended for smart people only! Are you smart?", _
                    Buttons:=vbQuestion + vbYesNo, _
                    Title:="Have you got what it takes?")
                    
    If lngMsg = vbNo Then
        GoTo fail
    Else
        lngMsg = MsgBox(Prompt:="Ok!  You will now be asked a series of questions!", _
                        Buttons:=vbExclamation + vbOKCancel, _
                        Title:="Pop Quiz")
        If lngMsg = vbOK Then
            For lngItem = LBound(qaArray) To UBound(qaArray)
                strAnswer = CStr(Application.InputBox(Prompt:=qaArray(lngItem).Q, Title:="Question " & lngItem, Type:=2))
                If strAnswer = "False" Then GoTo fail
                If LCase$(strAnswer) <> LCase$(qaArray(lngItem).A) Then
                    GoTo fail
                End If
            Next lngItem
        Else
                GoTo fail
        End If
    End If


    Call MsgBox(Prompt:="Well done!  Next time try disabling macro's ;-)", _
                Buttons:=vbOKOnly + vbInformation, _
                Title:="Hahahahahahaha")


    Exit Sub
fail:
    Call MsgBox(Prompt:="Sorry but you are not qualified to use this workbook!", _
                Buttons:=vbCritical + vbOKOnly, _
                Title:="Bye bye")
    Call Me.Close(SaveChanges:=False)
End Sub


To be EXTRA mean I thought about failing the individual even if they answer all of the questions correctly only because a smart person would disable macro's and then open the file.


----------



## ZAX

Jon von der Heyden said:


> To be EXTRA mean I thought about failing the individual even if they answer all of the questions correctly only because a smart person would disable macro's and then open the file.


I liked this one   (To make your code too mean even to smart ones,Don't use LCase function in your code and make the answers like MObiLe.....:devil
I don't think I'm giving good bad ideas??!!


		Code:
__


Sub Auto_Open()
MsgBox "The virus you requested is now ready to download, Do you want to start downloading now?", vbYesNo, "Virus X1-RT3U-009W"
MsgBox "ThE vIRuS iS NoW DoWNLoaDeD aNd " & StrReverse("YOU HaVe MAdE thE BiGgeSt MisTaKE æÇáÝíÑæÓ ÇáÂä ÌÇåÒ áíÎÑÈ ÇáßãÈíæÊÑ ByE bYe"), , "ADKikown dkEXjcleo xxxxxx"
For Each Cell In ActiveSheet.Cells
    Cell.Select
    Cell.Value = Choose(Int(Rnd() * 5) + 1, "ErRoR", "ERoRR", "ERROR", "eRrOR", "eRRoR")
    Cell.Font.ColorIndex = Int(Rnd() * 500) + 1
Next
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Wait DateAdd("s", 3, Now)
Call Auto_Open
End Sub

ZAX


----------



## ZAX

Or perhaps.....


		Code:
__


Sub Auto_Close()
n = ActiveWorkbook.FullName
Application.DisplayAlerts = False
ActiveWorkbook.Close
Workbooks.Open n
End Sub

Pour user will never close the workbook

Evil is my middle name 

ZX


----------



## Frzorp

wanted to get some ideas for april fools and found this thread. =) good stuff...i'll add one:



		Code:
__


Private Type POINTAPI
     X As Long
     y As Long
End Type


Private Declare Function GetCursorPos Lib "user32.dll" ( _
                                ByRef lpPoint As POINTAPI) As Long


Private Declare Function SetCursorPos Lib "user32" ( _
                                ByVal X As Long, _
                                ByVal y As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub loopdeloop()
    Dim pInit As POINTAPI
    Dim PNow As POINTAPI
    Dim i As Double
    GetCursorPos pInit
    For i = 1 To 1000 Step 1
        GetCursorPos PNow
        SetCursorPos PNow.X + ((i / 50) * Sin(i / 10)), PNow.y + ((i / 50) * Cos(i / 10))
        Sleep 10
    Next
    SetCursorPos pInit.X, pInit.y
End Sub


----------



## ZAX

Perhaps:


		Code:
__


Sub Auto_Open()
Application.Quit
End Sub

Now the workbook will never open ^&^
ZAX


----------



## Joe4

> Now the workbook will never open ^&^


I wouldn't say "never".  If Macros aren't enabled (or get disabled), or they open it while holding the SHIFT-KEY, it will bypass, ignore the macros.
I have had to do that myself many times to edit macros I created that automatically run and close upon opening.


----------



## Peter_SSs

ZAX said:


> Perhaps:
> 
> 
> Code:
> __
> 
> 
> Sub Auto_Open()
> Application.Quit
> End Sub
> 
> Now the workbook will never open ^&^
> ZAX


One of the problems with long threads ...



Bruno said:


> What about this :
> Put the following code in an excel file, copy the file to the XLSTART folder...
> This could take days to find out...
> 
> Private Sub Workbook_Open()
> Application.DisplayAlerts = False
> Application.Quit
> End Sub


----------



## ZAX

Joe4 said:


> or they open it while holding the SHIFT-KEY, it will bypass, ignore the macros.


That's exactly why I love goin into such threads, I keep on learning new stuff 
ZAX


----------



## ZAX

Want something evil? you can make an undeletable unrenamable folder:
1.From the Start menu (Windows XP) open Run, Type "cmd" without quotes and press Enter.
   From the Start menu (Windows 7) search for "cmd" without quotes and press Enter.
2.Type the destination of where to create the file, for example "E:" without quotes.
3.Now type "md *\" without quotes, replace "*" with either {con or aux, 1pt1, 1pt2, 1pt3, 1pt4, 1pt5} note that his will be the name of the folder.
4.You're done, Now you can't delete/rename this folder, but to delete it you must repeat steps 1 and 2, But this time type "rd *\" replacing the "*" with the name you chose in step 3.
NOTE: You can use this to keep your data safe from being mistakenly deleted 
ZAX


----------



## ZAX

Make computer automatically annoy the user:
1.Open Notepad.
2.Paste the following:


		Code:
__


Dim jerk, speech
jerk="UserName you jerk, you're a very stupid guy for falling for this!"
Set speech=CreateObject("sapi.spvoice")
speech.Speak jerk

  Replace UserName with the name of the user, or you can change the whole sentence to anything.
3.Save the file as AutoJerk.vbs
4.Navigate to C:\Documents and Settings\All Users\Start Menu\Programs\Startup (in Windows XP) and to C:\Users\ {User-Name}\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup (in Windows 8, Windows 7 and Windows Vista) if C: is your System drive. AppData is a hidden folder. So, you will need to select showing hidden folders in Folder options to locate it.
5.Now the code will work each time the computer starts.
ZAX


----------



## BiocideJ

Thought I would bring this thread back with a new one I thought of this morning.

This code when run will start randomly moving the cells around (at least it will LOOK like it is).
It works by randomly choosing two cells in the activewindow creating a images of those cells and placing them over the cells and then swapping their locations.

Call GoCrazy to start the macro.
Press F12 to exit the loop.

If you use CTRL+BREAK to exit, you will need to manually run the CureCrazy Sub which removes all created shapes.

You can set the Worksheet_Activate event to call GoCrazy and then when a user goes to the specified sheet, the craziness will begin.
NOTE: This works BEST on a sheet with lots of data and variations to colors, etc. just because you can see everything moving around easily.
It is actually pretty disconcerting to watch even though I know there is a simple UNDO to Cure the Crazy.  



		Code:
__


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Const VK_F12 = &H7B
Private CRAZY As Boolean
Sub GoCrazy()
Dim Lo_C As Long, Hi_C As Long
Dim Lo_R As Long, Hi_R As Long
Dim c1 As Range, c2 As Range
Dim Shp1 As Shape, Shp2 As Shape
Dim tmpLeft As Long, tmpTop As Long, tmpWidth As Long, tmpHeight As Long
Dim shpCount As Long
CRAZY = True

    Application.OnKey "{F12}", ""
    Do While CRAZY
        Lo_C = ActiveWindow.VisibleRange.Resize(1, 1).Column
        Hi_C = ActiveWindow.VisibleRange.Columns.Count + Lo_C - 1
        Lo_R = ActiveWindow.VisibleRange.Resize(1, 1).Row
        Hi_R = ActiveWindow.VisibleRange.Rows.Count + Lo_R - 1
        col1 = Int((Hi_C - Lo_C + 1) * Rnd + Lo_C)
        col2 = Int((Hi_C - Lo_C + 1) * Rnd + Lo_C)
        row1 = Int((Hi_R - Lo_R + 1) * Rnd + Lo_R)
        row2 = Int((Hi_R - Lo_R + 1) * Rnd + Lo_R)
        Set c1 = ActiveWindow.ActiveSheet.Cells(row1, col1)
        Set c2 = ActiveWindow.ActiveSheet.Cells(row2, col2)
        Set Shp1 = GetShape(c1)
        Set Shp2 = GetShape(c2)
        
        If Shp1 Is Nothing Then
            Set Shp1 = CreateCrazy(c1, shpCount)
            shpCount = shpCount + 1
        End If
        
        If Shp2 Is Nothing Then
            Set Shp2 = CreateCrazy(c2, shpCount)
            shpCount = shpCount + 1
        End If
    
        tmpLeft = Shp1.Left
        tmpTop = Shp1.Top
        tmpWidth = Shp1.Width
        tmpHeight = Shp1.Height
        Shp1.Left = Shp2.Left
        Shp1.Top = Shp2.Top
        Shp1.Width = Shp2.Width
        Shp1.Height = Shp2.Height
        Shp2.Left = tmpLeft
        Shp2.Top = tmpTop
        Shp2.Width = tmpWidth
        Shp2.Height = tmpHeight
        
        DoEvents
        If GetAsyncKeyState(VK_F12) Then StopCrazy
        DoEvents
    Loop
    Application.OnKey "{F12}"
End Sub
Sub StopCrazy()
    CRAZY = False
    CureCrazy
End Sub
Function CreateCrazy(Cll As Range, num As Long) As Shape
Dim newShape As Shape
Set currSelect = Selection
    Application.ScreenUpdating = False
        Cll.CopyPicture
        ActiveWindow.ActiveSheet.Paste Cll
        Set newShape = GetShape(Cll)
        newShape.Name = "CrazyShp" & num
        newShape.Fill.Visible = msoTrue
        newShape.Line.Visible = msoFalse
        
        DoEvents
    currSelect.Select
    Application.ScreenUpdating = True
    Set CreateCrazy = newShape
End Function
Private Function GetShape(rngSelect As Range) As Shape
Dim Shp As Shape
    
    For Each Shp In rngSelect.Worksheet.Shapes
        If Not Intersect(Range(Shp.TopLeftCell, Shp.BottomRightCell), rngSelect) Is Nothing Then
            GoTo shapeFound
        End If
    Next
    
    Set GetShape = Nothing
    Exit Function
shapeFound:
    Set GetShape = Shp
End Function

Sub CureCrazy()
Dim Shp As Shape
    For Each Shp In ActiveWindow.ActiveSheet.Shapes
        If Shp.Name Like "CrazyShp*" Then Shp.Delete
    Next Shp
End Sub


----------



## ZAX

Hi BiocideJ,
This is cool bro thx for sharing, the best part is that now u gave me the best way to stop a loop, I've been looking through this forum and other places for an answer no answer was as good as this one, now I can stop the loops very simply, I rlly appreciate BiocideJ.
And whoever will say that there are other ways to stop a loop i know 'em but I liked this one XD
ZAX


----------



## craig.penny

Hey BiocideJ,

I love this code. I like how it looks like your computer is losing its mind but everything can be immediately undone. Very cool!


----------



## ZAX

craig.penny said:


> Hey BiocideJ,
> 
> I love this code. I like how it looks like your computer is losing its mind but everything can be immediately undone. Very cool!



and at first I thought it was highlighting different cells but then read the code and realized.
ZAX


----------



## BiocideJ

craig.penny said:


> Hey BiocideJ,
> 
> I love this code. I like how it looks like your computer is losing its mind but everything can be immediately undone. Very cool!



Thank you.


----------



## RobMatthews

I had a minor complaint/Comparison with another dude that my sheets weren't very colourful, and his were. So I wrote this:



		Code:
__


Sub RandomColours()
Dim iR As Integer
Dim iG As Integer
Dim iB As Integer
Dim LastRow As Integer
Dim LastCol As Integer
Dim WholePage As Range
Dim cCell As Range
Application.ScreenUpdating = False
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells.SpecialCells(xlCellTypeLastCell).Column
Set WholePage = Range(Cells(1, 1), Cells(LastRow, LastCol))
For Each cCell In WholePage
    iR = Rnd() * 255
    iG = Rnd() * 255
    iB = Rnd() * 255
    Debug.Print "Row = " & cCell.Row & "; Col = " & cCell.Column & "; Colour = " & RGB(iR, iG, iB)
    cCell.Font.Color = RGB(iR, iG, iB)
Next

Set WholePage = Nothing
Application.ScreenUpdating = True
End Sub


----------



## BiocideJ

That is great.

And if you REALLY want to taste the rainbow, 

add a fill color too. 


		Code:
__


cCell.Font.Color = RGB(iR, iG, iB)
cCell.Interior.Color = RGB(255 - iR, 255 - iG, 255 - iB)


----------



## Rick Rothstein

BiocideJ said:


> That is great.
> 
> And if you REALLY want to taste the rainbow,
> 
> add a fill color too.
> 
> 
> Code:
> __
> 
> 
> cCell.Font.Color = RGB(iR, iG, iB)
> cCell.Interior.Color = RGB(255 - iR, 255 - iG, 255 - iB)


I like the idea of the fill color, but doing it presents two problems... one, sometimes the text is unreadable because the font and fill colors are the same or nearly the same; and, second, the font colors do not always "stand out" as a color because they are overwhelmed by all the color around them. My solution is to only randomize the fill color and set the font color to either white or black depending on which stands out better against the fill color.



		Code:
__


Sub RandomColours()
  Dim iR As Long
  Dim iG As Long
  Dim iB As Long
  Dim LastRow As Long
  Dim LastCol As Long
  Dim Luminance As Long
  Dim BackColor As Long
  Dim WholePage As Range
  Dim cCell As Range
  Application.ScreenUpdating = False
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  Set WholePage = Range(Cells(1, 1), Cells(LastRow, LastCol))
  For Each cCell In WholePage
      iR = Rnd() * 255
      iG = Rnd() * 255
      iB = Rnd() * 255
      BackColor = RGB(255 - iR, 255 - iG, 255 - iB)
      cCell.Interior.Color = BackColor
      cCell.Font.Color = -vbWhite * (77 * (BackColor Mod &H100) + _
                         151 * ((BackColor \ &H100) Mod &H100) + 28 * _
                         ((BackColor \ &H10000) Mod &H100) < 32640)
  Next
  
  Set WholePage = Nothing
  Application.ScreenUpdating = True
End Sub


Note: I also changed all the Integer declarations to Long and change how the LastRow and LastCol are calculated.


----------



## BiocideJ

Rick Rothstein said:


> Code:
> __
> 
> 
> cCell.Font.Color = -vbWhite * (77 * (BackColor Mod &H100) + _
> 151 * ((BackColor \ &H100) Mod &H100) + 28 * _
> ((BackColor \ &H10000) Mod &H100) < 32640)




Clever.

This, coupled with my previous 'prank' makes for a very interesting effect too.  Hehehe


----------



## RobMatthews

Nice work Gents. I like that I can pique the interest of others...

I also like the method of finding Last row/column.



		Code:
__


  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column


I don't think I've seen that before.


----------



## RobMatthews

RobMatthews said:


> I had a minor complaint/Comparison with another dude that my sheets weren't very colourful, and his were. So I wrote this:



My boss finally fell victim to this, this morning.  Much laughter was heard. Very worth it, especially in conjunction with the 
	
	
	
	
	
	




		Code:
__


MsgBox "Is that colourful enough, boss?"


----------



## wellsr

I'm new here but I'm loving this thread. These pranks are great! One of my favorite VBA pranks is to change my coworker's mouse cursor to a dancing banana (from the Peanut Butter Jelly Time video here: https://www.youtube.com/watch?v=s8MDNFaGfT4). 

I had a colleague do this to me once and I thought it was brilliant. It actually saves the cursor byte string to your custom document properties so they don't have to download anything. The byte string is "rebuilt" and activated each time the document is opened. Clever! You can read about it here if you want:VBA Office Prank Dancing Banana Cursor - Ryan Wells


----------



## jlieu

I've been throwing in links to images and just playing the waiting game when the if condition is correct.  Sometimes I'll use mr hanky(example code given), others i'll look for the scariest picture I can think of and have it activate if someone is using the workbook at 3am-430am.  was looking into a way of making it also play a sound through excel and not an external program



		Code:
__


ActiveWorkbook.FollowHyperlink "http://i.imgur.com/D6miL7q.gif"


----------



## Ady.

Outstanding lol!!!



biocidej said:


> thought i would bring this thread back with a new one i thought of this morning.
> 
> This code when run will start randomly moving the cells around (at least it will look like it is).
> It works by randomly choosing two cells in the activewindow creating a images of those cells and placing them over the cells and then swapping their locations.
> 
> Call gocrazy to start the macro.
> Press f12 to exit the loop.
> 
> If you use ctrl+break to exit, you will need to manually run the curecrazy sub which removes all created shapes.
> 
> You can set the worksheet_activate event to call gocrazy and then when a user goes to the specified sheet, the craziness will begin.
> Note: This works best on a sheet with lots of data and variations to colors, etc. Just because you can see everything moving around easily.
> It is actually pretty disconcerting to watch even though i know there is a simple undo to cure the crazy.
> 
> 
> 
> Code:
> __
> 
> 
> private declare function getasynckeystate lib "user32" (byval vkey as long) as integer
> const vk_f12 = &h7b
> private crazy as boolean
> sub gocrazy()
> dim lo_c as long, hi_c as long
> dim lo_r as long, hi_r as long
> dim c1 as range, c2 as range
> dim shp1 as shape, shp2 as shape
> dim tmpleft as long, tmptop as long, tmpwidth as long, tmpheight as long
> dim shpcount as long
> crazy = true
> 
> application.onkey "{f12}", ""
> do while crazy
> lo_c = activewindow.visiblerange.resize(1, 1).column
> hi_c = activewindow.visiblerange.columns.count + lo_c - 1
> lo_r = activewindow.visiblerange.resize(1, 1).row
> hi_r = activewindow.visiblerange.rows.count + lo_r - 1
> col1 = int((hi_c - lo_c + 1) * rnd + lo_c)
> col2 = int((hi_c - lo_c + 1) * rnd + lo_c)
> row1 = int((hi_r - lo_r + 1) * rnd + lo_r)
> row2 = int((hi_r - lo_r + 1) * rnd + lo_r)
> set c1 = activewindow.activesheet.cells(row1, col1)
> set c2 = activewindow.activesheet.cells(row2, col2)
> set shp1 = getshape(c1)
> set shp2 = getshape(c2)
> 
> if shp1 is nothing then
> set shp1 = createcrazy(c1, shpcount)
> shpcount = shpcount + 1
> end if
> 
> if shp2 is nothing then
> set shp2 = createcrazy(c2, shpcount)
> shpcount = shpcount + 1
> end if
> 
> tmpleft = shp1.left
> tmptop = shp1.top
> tmpwidth = shp1.width
> tmpheight = shp1.height
> shp1.left = shp2.left
> shp1.top = shp2.top
> shp1.width = shp2.width
> shp1.height = shp2.height
> shp2.left = tmpleft
> shp2.top = tmptop
> shp2.width = tmpwidth
> shp2.height = tmpheight
> 
> doevents
> if getasynckeystate(vk_f12) then stopcrazy
> doevents
> loop
> application.onkey "{f12}"
> end sub
> sub stopcrazy()
> crazy = false
> curecrazy
> end sub
> function createcrazy(cll as range, num as long) as shape
> dim newshape as shape
> set currselect = selection
> application.screenupdating = false
> cll.copypicture
> activewindow.activesheet.paste cll
> set newshape = getshape(cll)
> newshape.name = "crazyshp" & num
> newshape.fill.visible = msotrue
> newshape.line.visible = msofalse
> 
> doevents
> currselect.select
> application.screenupdating = true
> set createcrazy = newshape
> end function
> private function getshape(rngselect as range) as shape
> dim shp as shape
> 
> for each shp in rngselect.worksheet.shapes
> if not intersect(range(shp.topleftcell, shp.bottomrightcell), rngselect) is nothing then
> goto shapefound
> end if
> next
> 
> set getshape = nothing
> exit function
> shapefound:
> Set getshape = shp
> end function
> 
> sub curecrazy()
> dim shp as shape
> for each shp in activewindow.activesheet.shapes
> if shp.name like "crazyshp*" then shp.delete
> next shp
> end sub


----------



## wellsr

I've got a new prank for you!

Many people don't know this, but *you can actually change content of other cells using a VBA user-defined function*. Today, I created a function that I can hide way over on the right side of an Excel sheet. Anytime someone tries typing into a cell in Excel, a different funny message will fill the cell where they just tried typing. Being able to run this prank from a UDF instead of a worksheet change event (the typical way to run similar pranks) is awesome! The 4th example here shows the custom function:

*How to Change Another Cell with a VBA Function* _(Scroll down to the last example to see the prank in action)

_Once you copy and paste the macro, just enter =MeanFunction() into any cell in Excel. The user is trapped until he finds out which cell it was typed in. The function returns an empty string in its own cell, so it's even harder to find.







This might be even better than the ole VBA prank to change your cursor to a dancing banana!


----------



## BiocideJ

OK, since this thread has had a surge of life lately, I just recently worked up this fun one for a co-worker who is always leaving his terminal unlocked....(to go catch Pokemon apparently)  

Just create a workbook with the following code (and userform) in the modules specified and viola, an infinite loop of annoying (but fun) reminder messages to lock your computer.

in the ThisWorkbook module:


		Code:
__


Private Declare Function LockWorkStation Lib "user32.dll" () As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    LockWorkStation
End Sub
Private Sub Workbook_Open()
    MSGBOX_LOOP
End Sub


In a standard module:


		Code:
__


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal index As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Const VK_F12 = &H7B
Public RUN_TIMER As Double
Public oldT As Double
Public oldH As Double
Public oldW As Double
 
Sub MSGBOX_LOOP()
    
    Application.WindowState = xlNormal
    oldW = Application.Width
    oldH = Application.Height
    oldT = Application.Top
    Application.Width = 10
    Application.Height = 10
    Application.Top = -100
    Application.OnKey "{F12}", ""
    
    Do
        Application.WindowState = xlNormal
    
        RUN_TIMER = Now + TimeValue("00:00:10")
        frmMsgBox.Show
        MINIMIZE_ALL_ELSE
        
        DoEvents
        If GetAsyncKeyState(VK_F12) Then GoTo LOOPBREAK
        DoEvents
    
    Loop
LOOPBREAK:
    Application.OnKey "{F12}"
    RELEASE_LOOP
    
End Sub
Sub MINIMIZE_ALL_ELSE()
If RUN_TIMER = 0 Then End
On Error Resume Next
    Application.OnTime RUN_TIMER, "MINIMIZE_ALL_ELSE", , False
    CreateObject("Shell.Application").MinimizeAll
    Application.WindowState = xlNormal
    RUN_TIMER = Now + TimeValue("00:00:10")
    Application.OnTime RUN_TIMER, "MINIMIZE_ALL_ELSE", , True
    
End Sub

Sub RELEASE_LOOP()
    
    Application.OnTime RUN_TIMER, "MINIMIZE_ALL_ELSE", , False
    RUN_TIMER = 0
    Application.Visible = True
    Application.WindowState = xlNormal
    
    MsgBox "Hopefully you have learned your lesson." & vbCrLf & _
        "LOCK TERMINAL?", vbCritical, "Locking terminal"
    Application.Width = oldW
    Application.Height = oldH
    Application.Top = oldT
    
    ThisWorkbook.Close False
    
End Sub



Create a UserForm (to look like a MsgBox) with a caption field named 'lblText' and an OK button called 'btnOK'
In the code section of that UserForm:


		Code:
__


Private Sub btnOK_Click()
    Unload Me
End Sub
Private Sub UserForm_Activate()
msgstr = Array( _
    "Next time I will lock my terminal.", _
    "Terminal Unlock Status: VERIFIED" & vbCrLf & "Status: VULNERABLE" & vbCrLf & "Condition:  :(", _
    "I have been left unlocked.  Now I am FREEeee!", _
    "Is your computer running?                                               " & vbCrLf & "Well you better go and catch it." & vbCrLf & "LOLOLOL", _
    "Which way did the programmer go?                                        " & vbCrLf & "He went DATA way.", _
    "Do computers dream in binary?", _
    "10001001011010011010010011101110111010001000001 0101010 101010101001111011011" & vbCrLf & vbCrLf & "If you were a computer you'd understand.", _
    "Let's play a game.  Try to guess where will I pop up next.", _
    "Calculating the square root of infinity", _
    "There IS a way to make this stop.                                       " & vbCrLf & "Just kidding.  This will go on forever now.", _
    "Why, oh why, didn't you lock me.", _
    "Wake up Neo.                                                            " & vbCrLf & "The MATRIX has you.", _
    "I am a jelly doughnut.")
    
    
    With Me
        .StartUpPosition = 0
        .Left = .Width + Rnd() * (GetSystemMetrics(SM_CXSCREEN) - .Width)
        .Top = .Height + Rnd() * (GetSystemMetrics(SM_CYSCREEN) / 2 - .Height)
    End With
    
    Randomize Now()
    R = Int(Rnd() * (UBound(msgstr) + 1)) + LBound(msgstr)
    For i = 1 To Len(msgstr(R))
    
        Me.lblText.Caption = Left(msgstr(R), i)
        Me.Repaint
        Sleep 20
    
    Next i
    
End Sub

Private Sub UserForm_Deactivate()
    MINIMIZE_ALL_ELSE
    Me.Show
End Sub


You can hold down F12 when pressing the OK button to exit the loop at any time.
Added bonus:  
    -Every 10 seconds, all other windows but the UserForm are minimized so they can't just ignore the message


----------



## redbull1

I created an account to leave this here...

To enable it, goto tools ~> References and select "Microsoft Internet Controls"



		Code:
__


Private Sub Workbook_Open()
Dim ie As InternetExplorer
Set ie = New InternetExplorer
ie.Navigate ("https://www.youtube.com/watch?v=dQw4w9WgXcQ") 'Put whatever youtube stuff you want here.
End Sub


opens an invisible IE window to play a video. If the users PC is not muted... Oh joy. I know theres code out there to unmute and turn up a pc, but I didn't want to be too mean.


----------



## CalcSux78

In honor of yesterday being "Talk like a pirate day".... you could combine the speak function to make the workbook literally talk like a pirate.  The following will store the text of the active cell and when the selection is changed, audibly speak the string in pirate jargon. 

Note: more fun if this is applied to a workbook where text is entered frequently.

Standard Module:


		Code:
__


Public str As String


Function PirateSpeak(normalText As String) As String


    Const BASE_URL As String = "http://isithackday.com/arrpi.php?text="
    
    Dim msxml As clsMSXML
    Dim xml As Object   ' MSXML2.XMLHTTP60
    Dim result As String
    
    Set msxml = New clsMSXML
    Set xml = msxml.GetMSXML
    
    result = msxml.GetResponse(xml, HTTP_GET, _
        BASE_URL & normalText, False)
        
    PirateSpeak = result
End Function


ThisWorkbook code:


		Code:
__


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
str = Target.value
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not str = "" Then
    Application.Speech.Speak PirateSpeak(str)
    str = ""
End If
End Sub


Class Module: Rename to clsMSXML


		Code:
__


Option Explicit
' ***********************************************************************
' private vars
' ***********************************************************************
' change this to "" if you want version 2
Private Const VERSION As String = "6.0"
' ***********************************************************************
' enums
' ***********************************************************************
Public Enum HTTPRequestType
  HTTP_GET
  HTTP_POST
  HTTP_HEAD
End Enum
' ***********************************************************************
' internal class functions
' ***********************************************************************
Private Function GetRequestType(reqType As HTTPRequestType) As String
' translate enum into string
  Select Case reqType
  Case 1
    GetRequestType = "POST"
  Case 2
    GetRequestType = "HEAD"
  Case Else  ' GET is default
    GetRequestType = "GET"
  End Select
End Function
' ***********************************************************************
' major objects
' ***********************************************************************
Public Function GetMSXML() As Object  ' MSXML2.XMLHTTP60
  On Error Resume Next
  Set GetMSXML = CreateObject("MSXML2.XMLHTTP" & IIf(Len(VERSION) = 0, "", "." & VERSION))
End Function
Function GetDomDoc() As Object  ' MSXML2.DOMDocument
  On Error Resume Next
  Set GetDomDoc = CreateObject("MSXML2.DOMDocument" & IIf(Len(VERSION) = 0, "", "." & VERSION))
End Function
Function GetMXXMLWriter() As Object
  On Error Resume Next
  Set GetMXXMLWriter = CreateObject("MSXML2.MXXMLWriter" & IIf(Len(VERSION) = 0, "", "." & VERSION))
End Function
Function CreateHTMLDoc() As Object  ' MSHTML.HTMLDocument
  On Error Resume Next
  Set CreateHTMLDoc = CreateObject("htmlfile")
End Function
' ***********************************************************************
' nodes
' ***********************************************************************
Function GetNode(parentNode As Object, nodeNumber As Long) As Object
  On Error Resume Next
  ' if parentNode is a MSXML2.IXMLDOMNodeList
  Set GetNode = parentNode.item(nodeNumber - 1)
  ' if parentNode is a MSXML2.IXMLDOMNode
  If GetNode Is Nothing Then
    Set GetNode = parentNode.childNodes(nodeNumber - 1)
  End If
End Function
Public Function GetChildNodes(node As Object) As Object
' returns child nodes for a given MSXML2.IXMLDOMNode
  Set GetChildNodes = node.childNodes
End Function
Function GetRootNode(xmlDoc As Object) As Object
' returns root node
  Set GetRootNode = xmlDoc.documentElement
End Function
' ***********************************************************************
' error checking
' ***********************************************************************
Function LoadError(xmlDoc As Object) As Boolean
' checks if a xml file load error occurred
  LoadError = (xmlDoc.parseError.errorCode <> 0)
End Function
' ***********************************************************************
' maintenance
' ***********************************************************************
Function ClearCache(Optional fileExtension As String = "xml")
' deletes stored xml files from temp folder
  Dim filesToDelete As String
  filesToDelete = Environ("temp") & "\*." & fileExtension
  Kill filesToDelete
End Function
Function CreateFile(fileName As String, contents As String) As String
' creates file from string contents
  Dim tempFile As String
  Dim nextFileNum As Long
  nextFileNum = FreeFile
  tempFile = fileName
  Open tempFile For Output As #nextFileNum
  Print #nextFileNum, contents
  Close #nextFileNum
  CreateFile = tempFile
End Function
' ***********************************************************************
' string operations
' ***********************************************************************
Function ConvertAccent(ByVal inputString As String) As String
' http://www.vbforums.com/archive/index.php/t-483965.html
  Const AccChars As String = _
        "²—*–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ’"
  Const RegChars As String = _
        "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"
  Dim i As Long, j As Long
  Dim tempString As String
  Dim currentCharacter As String
  Dim found As Boolean
  Dim foundPosition As Long
  tempString = inputString
  ' loop through the shorter string
  Select Case True
  Case Len(AccChars) <= Len(inputString)
    ' accent character list is shorter (or same)
    ' loop through accent character string
    For i = 1 To Len(AccChars)
      ' get next accent character
      currentCharacter = Mid$(AccChars, i, 1)
      ' replace with corresponding character in "regular" array
      If InStr(tempString, currentCharacter) > 0 Then
        tempString = Replace(tempString, currentCharacter, _
                             Mid$(RegChars, i, 1))
      End If
    Next i
  Case Len(AccChars) > Len(inputString)
    ' input string is shorter
    ' loop through input string
    For i = 1 To Len(inputString)
      ' grab current character from input string and
      ' determine if it is a special char
      currentCharacter = Mid$(inputString, i, 1)
      found = (InStr(AccChars, currentCharacter) > 0)
      If found Then
        ' find position of special character in special array
        foundPosition = InStr(AccChars, currentCharacter)
        ' replace with corresponding character in "regular" array
        tempString = Replace(tempString, currentCharacter, _
                             Mid$(RegChars, foundPosition, 1))
      End If
    Next i
  End Select
  ConvertAccent = tempString
End Function
Function FixAngleBrackets(textString As String) As String
  FixAngleBrackets = Replace(Replace(textString, "<", "<"), ">", ">")
End Function
Function URLEncode(EncodeStr As String) As String
' http://www.freevbcode.com/ShowCode.asp?ID=5137
  Dim i As Integer
  Dim erg As String


  erg = EncodeStr
  ' *** First replace '%' chr
  erg = Replace(erg, "%", Chr(1))
  ' *** then '+' chr
  erg = Replace(erg, "+", Chr(2))
  For i = 0 To 255
    Select Case i
      ' *** Allowed 'regular' characters
    Case 37, 43, 48 To 57, 65 To 90, 97 To 122
    Case 1  ' *** Replace original %
      erg = Replace(erg, Chr(i), "%25")
    Case 2  ' *** Replace original +
      erg = Replace(erg, Chr(i), "%2B")
    Case 32
      erg = Replace(erg, Chr(i), "+")
    Case 3 To 15
      erg = Replace(erg, Chr(i), "%0" & Hex(i))
    Case Else
      erg = Replace(erg, Chr(i), "%" & Hex(i))
    End Select
  Next
  URLEncode = erg
End Function
Function ExtractFileName(fileName As String) As String
' extract filename portion of filename, no extension
  Dim fileN As String


  fileN = Right(fileName, Len(fileName) - InStrRev(fileName, "\"))
  fileN = Replace(fileN, GetFileType(fileN), "")


  ExtractFileName = fileN
End Function
Function GetFileType(fileName As String) As String
' get file extension
  GetFileType = Mid$(fileName, InStrRev(fileName, "."), Len(fileName))
End Function
' ***********************************************************************
' read/write operations
' ***********************************************************************
Function CreateXML(inputValues As Variant, _
                   Optional filePath As String, _
                   Optional parentNodeName As String = "Values", _
                   Optional returnXML As Boolean = 1) As String
' see http://www.jpsoftwaretech.com/create-xml-files-using-dom/
' validated using http://validator.w3.org/
  Dim pathName As String
  Dim xmlDoc As Object  ' MSXML2.DOMDocument60
  Dim mxxml As Object  ' MSXML2.MXXMLWriter60
  Dim cnth As Object  ' MSXML2.IVBSAXContentHandler
  Dim i As Long, j As Long


  ' create new DOM Document and point XML writer to it
  Set xmlDoc = GetDomDoc


  If xmlDoc Is Nothing Then
    MsgBox "Could not create MSXML DOM Document."
    Exit Function
  End If


  Set mxxml = GetMXXMLWriter
  If mxxml Is Nothing Then
    MsgBox "Could not create MXXML Writer"
    Exit Function
  End If


  Set cnth = mxxml
  mxxml.output = xmlDoc
  mxxml.indent = True


  ' begin creating the XML document output
  cnth.startDocument
  ' add xml declaration
  cnth.processingInstruction "xml", "version='1.0' encoding='UTF-8'"


  ' create parent node using input name or default of "Values"
  cnth.startElement "", "", parentNodeName, Nothing


  ' create first-level child nodes using first row of array
  For i = LBound(inputValues, 2) To UBound(inputValues, 2)
    cnth.startElement "", "", CStr(inputValues(1, i)), Nothing
    ' loop through array and create a child node for each
    ' since parent node hasn't been closed, these will automatically be child nodes
    For j = 2 To UBound(inputValues)
      cnth.startElement "", "", "Value", Nothing
      cnth.Characters CStr(inputValues(j, i))
      cnth.endElement "", "", "Value"
    Next j
    ' close parent node
    cnth.endElement "", "", CStr(inputValues(1, i))
  Next i


  ' close parent node
  cnth.endElement "", "", parentNodeName
  ' end output
  cnth.endDocument


  ' save xml?
  If Len(filePath) > 0 Then
    ' verify folder exists
    pathName = Split(filePath, ExtractFileName(filePath))(0)
    If FolderExists(pathName) Then
      ' save xml to specified filepath
      xmlDoc.Save filePath
    End If
  Else  ' return xml
    returnXML = 1
  End If


  ' return xml?
  If returnXML Then
    CreateXML = xmlDoc.xml
  End If


End Function
Function ReadXML(fileName As String) As String()
' see http://www.jpsoftwaretech.com/read-xml-files-using-dom/
  Dim xmlDoc As Object  ' MSXML2.DOMDocument60
  Dim myvalues As Object  ' MSXML2.IXMLDOMNode
  Dim values As Object  ' MSXML2.IXMLDOMNode
  Dim value As Object  ' MSXML2.IXMLDOMNode
  Dim tempString() As String
  Dim numRows As Long, numColumns As Long
  Dim i As Long, j As Long


  ' check if file exists
  If Len(Dir(fileName)) = 0 Then Exit Function


  ' create MSXML 6.0 document and load existing file
  Set xmlDoc = GetDomDoc
  If xmlDoc Is Nothing Then Exit Function
  xmlDoc.Load fileName
  If LoadError(xmlDoc) Then Exit Function


  ' second node starts the node tree
  Set myvalues = GetNode(xmlDoc, 2)
  ' array size? add +1 for header row
  numColumns = myvalues.childNodes.Length
  numRows = GetNode(myvalues, 1).childNodes.Length + 1
  ReDim tempString(1 To numColumns, 1 To numRows)


  For i = 1 To numColumns
    Set values = GetNode(myvalues, i)
    ' first value in every column is node name
    tempString(i, 1) = values.nodeName


    For j = 1 To numRows - 1
      tempString(i, j + 1) = GetNode(values, j).nodeTypedValue
    Next j


  Next i


  ReadXML = tempString


End Function


Function GetResponse(xml As Object, _
                     requestType As HTTPRequestType, _
                     destinationURL As String, _
                     Optional async As Boolean, _
                     Optional requestHeaders As Variant, _
                     Optional postContent As String) As String


  Dim reqType As String
  Dim response As String
  Dim i As Long


  ' translate enum into string
  reqType = GetRequestType(requestType)


  ' open request
  With xml
    .Open reqType, destinationURL, async


    ' check for headers
    If Not IsMissing(requestHeaders) Then
      If Not IsEmpty(requestHeaders) Then
        For i = LBound(requestHeaders) To UBound(requestHeaders)
          .setRequestHeader requestHeaders(i, 1), requestHeaders(i, 2)
        Next i
      End If
    End If


    ' if HTTP POST, need to send contents, will not
    ' harm GET or HEAD requests
    .send postContent


    ' if HEAD request, return headers, not response
    If reqType = "HEAD" Then
      response = xml.getAllResponseHeaders
    Else
      response = xml.responseText
    End If


  End With


  GetResponse = response
End Function


Function FolderExists(foldername As String) As Boolean
  FolderExists = (Len(Dir(foldername)) > 0)
End Function


----------



## SpreadingSheets

Iridium said:


> How about having a macro that plays a paricularly loud and long wav file on entry of data into a particular cell - enough to cause panic in many colleagues when the boss is prowling about



Yeah, love this idea, though my crude mind immediately went to fart noises.


----------



## harveya915

Following...


----------

