April Fools Programming, anyone?

[Susan]

found these on the internet over the years..................
====================
Private Sub Workbook_Open()
MsgBox "This message intentionally left blank"
End Sub
===================
Private Sub Workbook_Open()
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
===================
Option Explicit

'this is the mouse joke function

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


Public 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)
ActiveWorkbook.Worksheets(1).Visible = True
'an all-black worksheet
ActiveWorkbook.Worksheets(1).Select
Call CloseCD
Config = vbOK + vbExclamation
Msg = "Insufficient cheese error!!!!!!" & vbCrLf & vbCrLf
Msg = Msg & "Workbook has been lost!!!"
Ans = MsgBox(Msg, Config)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(1).Visible = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


Sub OpenCD()
OpenOrShutCDDrive (1)
End Sub

Sub CloseCD()
OpenOrShutCDDrive (0)
End Sub


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
=========================
susan