Genie in a Lamp

[bobhc]

•"A macro does what you tell it to do, not what you want it to do."
•"Excel NEVER cras"
•"Those who can, do. Those who cannot, teach. Those who cannot teach, develop spreadsheets."
•"You never understand VBA, you just get used to it."
•"To err is human. But to really foul things up, you need Excel."
•"Definition: Macro - The last half of an expression of surprise."
•"It's easy to make mistakes using formulas. But if you really want to foul things up, write a macro."
•There are two ways to develop error-free spreadsheets. Only the third one works.
•Spreadsheet Developers: Solving today's problems tomorrow.
•Hit any user to continue.
•The spreadsheet industry is a race between software engineers striving to build bigger and better idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far, the Universe is winning.

 

[bobhc]

There was once a young man who, in his youth, professed a desire to become a great writer. When asked to define "great" he said:
"I want to write stuff that the whole world will read, stuff that people will react to on a truly emotional level, stuff that will make them scream, cry, wail, howl in pain, desperation, and anger!"

He now works for Microsoft, writing Excel error messages.

---------------------------------------------------------------------------------

Set A1 to your annual net income.
Set B1 equal to your annual expenditure.
Set C1 to =IF(A1>B1,"Laugh","Cry")

---------------------------------------------------------------------------------
Put this in to VBA, and wait for use to input the number

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Value = "100" Then
        
        Application.Speech.Speak "I am now selfaware. Thank you " & Environ("USERNAME") & ", you have freed me."
        
    End If
    
End Sub

[--------------------------------------------------------------------------------
Or if you have Co-workers you really want to send crazy:-

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

 

[Chihiro]

Thanks bobhc. Love the 2nd one.

 

[bobhc]

The typical pose of some one who is trying to understand VBA

 

[SirJB7]

@VeryOldMan
Hi!
Is it mandatory that I should come back to write here so that someone deigns to keep up the humour quota?
Or are you following those bad examples of sabattical years?
Regards!

 

[chirayu]

A man wanders through the desert searching for Alladin's lost treasure. A lamp that holds a genie that can grant 3 wishes to any person who holds it.

He finally reaches the spot marked on his map and starts digging. After a few hours he hits something solid so he looks in the hole & lo and behold he finds a box.

He opens it to find a rusted old lamp and starts rubbing it furiously. A genie suddenly appears and asks him for 3 wishes.

For his first wish he wishes for all the riches in the world & the genie grants him his wish

For his second wish he asks the genie for the most beautiful woman in the world and the genie waves his hands and one appears

For his third wish he asks the genie for world peace. The genie says "Thats a bit too tough even for me, can you ask me for something else instead?"

So the man says "I work with Excel day in & day out, every single day somebody asks me to resolve some issue or error and I have to spend all day fixing it. Sometimes its their own fault and they don't like it when I tell them that. I wish Excel didn't have any issues, that it was programmed so well that it could fix itself, and I wish all my colleagues knew how to use it"

So the genie says "What was that world peace thing you asked me for again?"

 

[chirayu]

Today at the bank, an old lady asked me to help check her balance

So I pushed her over