![]() |
April Fools Programming, anyone?
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 |
All times are GMT +1. The time now is 02:51 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com