Force a Message Box to close unanswered
 

Hi,

One of the spreadsheets we have has the problem that it keeps being
left open, I therefore want it to close after a set time, but if their
is someone working on the spreadsheet I would like it to ask them to
press OK to keep it open before it closes.
However once the question is asked it just hangs there until OK is
pressed.
I would like it to close if the question hasn't been answered (OK
pressed) in about 30 seconds.
Does anyone know how to do this?

This is the code I am using at the moment:



Private Sub Counter()
THE_COUNT = THE_COUNT + 1

If THE_COUNT 5 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending"

Dim Response As Variant
Response = MsgBox("Click OK to keep open", vbExclamation +
vbOKOnly, "Closing")

If Response = vbOK Then
THE_COUNT = 1
Call Application.OnTime(Now() + TimeValue("00:01:00"),
"Counter")
Else
' Want it to carry on and close if the message hasn't been
answered in 30 secs
Call Workbooks("CloseOnTime.xls").Close(True)
End If


ElseIf THE_COUNT = 0 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending 0"
Exit Sub

Else
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Call Application.OnTime(Now() + TimeValue("00:01:00"), "Counter")
End If

End Sub


Thanks for your help
Jennie


--
jennie
------------------------------------------------------------------------
jennie's Profile: http://www.excelforum.com/member.php...fo&userid=6706
View this thread: http://www.excelforum.com/showthread...hreadid=475326

Force a Message Box to close unanswered
 

Hi Jennie,

See Chip Pearson's Timed Msgbox post:

http://tinyurl.com/c36y8

---
Regards,
Norman



"jennie" wrote in
message ...

Hi,

One of the spreadsheets we have has the problem that it keeps being
left open, I therefore want it to close after a set time, but if their
is someone working on the spreadsheet I would like it to ask them to
press OK to keep it open before it closes.
However once the question is asked it just hangs there until OK is
pressed.
I would like it to close if the question hasn't been answered (OK
pressed) in about 30 seconds.
Does anyone know how to do this?

This is the code I am using at the moment:



Private Sub Counter()
THE_COUNT = THE_COUNT + 1

If THE_COUNT 5 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending"

Dim Response As Variant
Response = MsgBox("Click OK to keep open", vbExclamation +
vbOKOnly, "Closing")

If Response = vbOK Then
THE_COUNT = 1
Call Application.OnTime(Now() + TimeValue("00:01:00"),
"Counter")
Else
' Want it to carry on and close if the message hasn't been
answered in 30 secs
Call Workbooks("CloseOnTime.xls").Close(True)
End If


ElseIf THE_COUNT = 0 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending 0"
Exit Sub

Else
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Call Application.OnTime(Now() + TimeValue("00:01:00"), "Counter")
End If

End Sub


Thanks for your help
Jennie


--
jennie
------------------------------------------------------------------------
jennie's Profile:
http://www.excelforum.com/member.php...fo&userid=6706
View this thread: http://www.excelforum.com/showthread...hreadid=475326