Macro for turning screenpicture upside-down??

Posted by espen on September 05, 2001 1:05 PM

I would like to have some fun at my company, and looking for a macro code that will fex turn the whole screen upside down, or something else. And also, I would like to know how to erase the screen with some kind of a code.

This might seem very childish, but it will be just the right thing for my collegues.

I will be very happy if someone could help me out on this one.

Peace

Posted by . on September 05, 2001 2:40 PM

http://j-walk.com/ss/excel/files/general.htm - Menu Shenanigans

Posted by espen on September 05, 2001 4:27 PM

Re: http://j-walk.com/ss/excel/files/general.htm - Menu Shenanigans

Thank you

But how can i rewrite that formula so that it will damage more than just the menu, fex miss up all the numbers at the excelsheet?

Peace

Espen

Posted by . on September 06, 2001 2:50 AM

Re: http://j-walk.com/ss/excel/files/general.htm - Menu Shenanigans

If you really just want to play a joke on someone, I would have thought that the Menu Shenanigans is quite adequate. Your desire to mess up someone's worksheet data sounds a bit sinister to me.

Posted by espen on September 06, 2001 5:23 AM

Re: http://j-walk.com/ss/excel/files/general.htm - Menu Shenanigans

Well i understand your thoughts, but this is actually my own sheet and my own work. And I thought that it would be fun to make a button whith a text that just "has" got to be pushed, and than make them a bit worry for what they've done wrong.

Posted by Henry Root on September 06, 2001 6:47 AM

Re: http://j-walk.com/ss/excel/files/general.htm - Menu Shenanigans

Try this. It hides the active sheet and adds a new sheet called "All Data Deleted" :-

Sub Shenanigans()
Dim toHide As Worksheet
Dim alarm As Variant
Dim I As Integer
Set toHide = ActiveSheet
Sheets.Add.Name = "All Data Deleted"
Cells.Interior.ColorIndex = 3
toHide.Visible = False
Set alarm = ActiveSheet.Shapes.AddTextEffect(msoTextEffect2, _
"ALARM !", "Times New Roman", 88#, msoTrue, msoFalse, _
36, 170)
On Error Resume Next
alarm.Select
For I = 1 To 6
If I Mod 2 = 0 Then
Selection.ShapeRange.Adjustments. _
Item(1) = 0.9906
Else
Selection.ShapeRange.Adjustments. _
Item(1) = 0.2657
End If
Application.Wait Now + TimeValue("00:00:01")
DoEvents
Next
alarm.Cut
MsgBox "A fatal error has occurred ! All data has been permanently erased"
MsgBox "Do you want to close this file and pretend you did not cause the loss of data ?"
Cells.Interior.ColorIndex = xlNone
End Sub

Posted by espen on September 07, 2001 11:38 PM

Thank you for helping me

I haven't had time to check it out, but it seems like a GREAT formula!!

Thank you very very much

Espen