Option Explicit

Public Declare Function SetTimer Lib "user32" ( _

    ByVal hwnd As Long, _

    ByVal nIDEvent As Long, _

    ByVal uElapse As Long, _

    ByVal lpTimerfunc As Long) As Long



Public Declare Function KillTimer Lib "user32" ( _

    ByVal hwnd As Long, _

    ByVal nIDEvent As Long) As Long



'==========Public Declarations ==============================

Public TimerID As Long            'Turn On and Off with this ID

Public TimerActive As Boolean     'Is the timer active

Public Const tmMin As Long = 2    'Min time allowed

Public Const tmDef As Long = 5    'Default if min set low

'============================================================



Public Sub ActivateMyTimer(ByVal Sec As Long)

Sec = Sec * 1000

If TimerActive Then Call DeActivateMyTimer



On Error Resume Next

TimerID = SetTimer(0, 0, Sec, AddressOf Timer_CallBackFunction)

TimerActive = True



End Sub



Public Sub DeActivateMyTimer()

    KillTimer 0, TimerID

End Sub



Sub Timer_CallBackFunction(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, _

    ByVal Systime As Long)



Application.SendKeys "~", True

If TimerActive Then Call DeActivateMyTimer



End Sub



Function TmMsgBox(sMsg As String, Btn As VbMsgBoxStyle, Optional ShowFor As Long, _

        Optional sTitle As String) As VbMsgBoxResult

        

If sTitle = "" Then sTitle = Application.Name

If ShowFor < tmMin Then ShowFor = tmDef

ActivateMyTimer ShowFor

TmMsgBox = MsgBox(sMsg, Btn, sTitle)

DeActivateMyTimer



End Function



Sub aTest()

Dim Answer



Answer = TmMsgBox("Is this OK?", vbYesNo + vbDefaultButton1, , "Data Entry check")



MsgBox Answer



End Sub



'// Here is a another test routine that will

'// Dismiss the msgbox in 5 Seconds

Const Msg As String = "This is a Timer test for "

Const Msg1 As String = "This will be Dismissed in "

Const Msg2 As String = " Seconds"

Const S As Long = 5



Sub TestStdMsgbox()

ActivateMyTimer S

MsgBox Msg & " vbAbortRetryIgnore" & vbCr & Msg1 & S & Msg2, vbAbortRetryIgnore

ActivateMyTimer S

MsgBox Msg & " vbApplicationModal" & vbCr & Msg1 & S & Msg2, vbApplicationModal

ActivateMyTimer S

MsgBox Msg & " vbDefaultButton1" & vbCr & Msg1 & S & Msg2, vbDefaultButton1

ActivateMyTimer S

MsgBox Msg & " vbDefaultButton2" & vbCr & Msg1 & S & Msg2, vbDefaultButton2

ActivateMyTimer S

MsgBox Msg & " vbExclamation" & vbCr & Msg1 & S & Msg2, vbExclamation

ActivateMyTimer S

MsgBox Msg & " vbInformation" & vbCr & Msg1 & S & Msg2, vbInformation

ActivateMyTimer S

MsgBox Msg & " vbMsgBoxHelpButton" & vbCr & Msg1 & S & Msg2, vbMsgBoxHelpButton

ActivateMyTimer S

MsgBox Msg & " vbMsgBoxRight" & vbCr & Msg1 & S & Msg2, vbMsgBoxRight

ActivateMyTimer S

MsgBox Msg & " vbMsgBoxSetForeground" & vbCr & Msg1 & S & Msg2, vbMsgBoxSetForeground

ActivateMyTimer S

MsgBox Msg & " vbOKCancel" & vbCr & Msg1 & S & Msg2, vbOKCancel

ActivateMyTimer S

MsgBox Msg & " vbQuestion" & vbCr & Msg1 & S & Msg2, vbQuestion

ActivateMyTimer S

MsgBox Msg & " vbRetryCancel" & vbCr & Msg1 & S & Msg2, vbRetryCancel

ActivateMyTimer S

MsgBox Msg & " vbSystemModal" & vbCr & Msg1 & S & Msg2, vbSystemModal

ActivateMyTimer S

MsgBox Msg & " vbYesNo" & vbCr & Msg1 & S & Msg2, vbYesNo

ActivateMyTimer S

MsgBox Msg & " vbYesNoCancel" & vbCr & Msg1 & S & Msg2, vbYesNoCancel



'Needed here JIC User cancels

DeActivateMyTimer



End Sub