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

[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]

This gives people a very useful toolbar:

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

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

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]

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

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?