VB and VBA Users Source Code: Displaying a Timed Msgbox
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Displaying a Timed Msgbox
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, January 03, 2001
Hits:
1280
Category:
Windows API
Article:
To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post: '------------API calls for Msgbox2------------------------ '------------MUST BE PLACED IN A STANDARD MODULE---------- Option Explicit 'API calls for Msgbox2. Must be placed in a standard module Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long Private zsMessageTitle As String, lTimerId As Long 'Purpose : Stops the timer routine 'Inputs : N/A 'Outputs : Returns True if the timer routine was stopped 'Author : Andrew Baker 'Date : 15/10/2000 15:24 'Notes : Code must be placed in a module 'Revisions : Function EndTimer() As Boolean If lTimerId Then lTimerId = KillTimer(0&, lTimerId) lTimerId = 0 EndTimer = True End If End Function 'Purpose : Starts the continuous calling of a private routine at a specific time interval. 'Inputs : lInterval The interval (in ms) at which to call the routine 'Outputs : N/A 'Author : Andrew Baker 'Date : 15/10/2000 15:30 'Notes : Code must be placed in a module 'Revisions : Sub StartTimer(lInterval As Long) If lTimerId Then 'End Current Timer EndTimer End If lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine) End Sub 'Purpose : Routine which is called repeatedly by the timer API. 'Inputs : Inputs are automatically generated. 'Outputs : 'Author : Andrew Baker 'Date : 15/10/2000 15:32 'Notes : 'Revisions : Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long) Const WM_CLOSE = &H10 Dim lHwndMsgbox As Long 'Find the Msgbox lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle) 'Close Msgbox Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&) End Sub 'Purpose : Extended version of Msgbox, has extra parameter to set time msgbox is displayed for 'Inputs : As per Msgbox ' [DisplayTime] The time in MS to display the message. 'Outputs : As per Msgbox 'Author : Andrew Baker 'Date : 03/01/2001 13:23 'Notes : 'Revisions : Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult If DisplayTime > 0 Then 'Enable the timer StartTimer DisplayTime zsMessageTitle = Title End If Msgbox2 = MsgBox(Prompt, Buttons, Title) 'Stop the timer EndTimer End Function 'Demonstration routine Sub TestMessage() Dim lRetVal As VbMsgBoxResult lRetVal = Msgbox2("This message will be displayed for 2 seconds", vbOKCancel + vbInformation, "Test Message", 2000) Debug.Print lRetVal End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
