It won't work if you don't use the code supplied, normal MsgBox doesn't time
out.
Dim RunWhen As Double
Sub Vikram()
Const TIMED_OUT As Long = -1
'my codes
ws1.Range("A6").Value _
= "Last Run : " & Format(Now(), "ddd, dd/mm/yyyy hh:mm:ss
AM/PM")
response = TimedMsgBox("Do you want to Start Timer ?", "AppTitle", 20)
If response = vbYes Or response = TIMED_OUT Then
StartTimer
Else
StopTimer
End If
End Sub
Sub StartTimer()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Summery")
'RunWhen = DateSerial(2006, 7, cRunIntervalDates)
'RunWhen = Now + TimeSerial(0, ws1.Range("E4"), 0)
RunWhen = Now + TimeSerial(0, 0, cRunIntervalTime * ws1.Range("E5"))
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
'----------------------------------------------------------------
Function TimedMsgBox(Msg As String, _
Title As String, _
Duration As Long) As Long
'----------------------------------------------------------------
Dim cTime As Long
Dim WSH As Object
Set WSH = CreateObject("WScript.Shell")
TimedMsgBox = WSH.Popup("Open an Excel file?!", Duration, "Question",
vbYesNo)
End Function
--
HTH
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
Vikram Dhemare said:
Hello Mr. Bob,
Thanks for your early response. My programming language is not good enough.
I have tried with the codes supplied by you but not getting the desired
answer.
The codes in my programming are given below. Could you help me to solve this.
'my codes
ws1.Range("A6").Value _
= "Last Run : " & Format(Now(), "ddd, dd/mm/yyyy hh:mm:ss AM/PM")
response = MsgBox("Do you want to Start Timer ?", vbYesNo + vbDefaultButton,
1)
'if here the user does not respond for 10 sec, then the programme sould
assume the response vbYes, & then start the next procedure. Is it possible?
If response = vbYes Then
StartTimer
End If
If response = vbNo Then
StopTimer
End If
-------------------------------------------------------------------------- ---------------------
Start Timer & Stop Timer is another procedures. like:
Sub StartTimer()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Summery")
'RunWhen = DateSerial(2006, 7, cRunIntervalDates)
'RunWhen = Now + TimeSerial(0, ws1.Range("E4"), 0)
RunWhen = Now + TimeSerial(0, 0, cRunIntervalTime * ws1.Range("E5"))
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub