Timer question

[ordnance1]

I have this timer code I got courtesy of Chip Pearson
(http://www.cpearson.com/excel/TimedClose.htm) and am wondering if it can be
altered in such a way that when I get down to 3 minutes (NUM_MINUTES is set
to 10 minutes) ClosingSplashScreen.Show will run?

Private Sub Workbook_Open()

On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
RunWhen = Now + TimeSerial(0, NUM_MINUTES, 0)
Application.OnTime RunWhen, "SaveAndClose", , True

End Sub

 

[joel]

Change the ONTIME timer to 1 minute instead of 10 minutes. Then coun
ther number of 1 minute events to determine when 3 minutes are left lik
the code below



Public RunWhen As Double
Public Dim Minute_Counter as Integer
Public Const NUM_MINUTES = 10
Public Const INTERRUPT_TIME = 1


Public Sub SaveAndClose()
Minute_Counter = Minute_Counter - 1

Select Case Minute_Counter
Case 3 : 'Add code here to run closing message

Case is <= 0:
ThisWorkbook.Close savechanges:=True
End select
End Sub


Private Sub Workbook_Open()
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
Minute_Counter = NUM_MINUTES
RunWhen = Now + TimeSerial(0, INTERRUPT_TIME, 0)
Application.OnTime RunWhen, "SaveAndClose", , True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Minute_Counter = 0
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
Minute_Counter = NUM_MINUTES
RunWhen = Now + TimeSerial(0, INTERRUPT_TIME, 0)
Application.OnTime RunWhen, "SaveAndClose", , True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)

On Error Resume Next
Application.OnTime RunWhen, "SaveAndClose", , False
On Error GoTo 0
Minute_Counter = NUM_MINUTES
RunWhen = Now + TimeSerial(0, INTERRUPT_TIME, 0)
Application.OnTime RunWhen, "SaveAndClose", , True

End Sub

 

[EricG]

You can simply add a second OnTime function. Define the CONSTANT
SPLASH_MINUTES to be 7, and then add this code:

RunWhenSplash = Now + TimeSerial(0, SPLASH_MINUTES, 0)
Application.OnTime RunWhenSplash, "ShowMySplash", , True

Public Sub ShowMySplash
ClosingSplashScreen.Show ' Modal or Not?
' Do something based on user response?
End Sub

Don't forget to cancel the second OnTime before you quit Excel:

Application.OnTime RunWhenSplash, "ShowMySplash", , False

HTH,

Eric

 

[ordnance1]

I will give that a try tomorrow. Thanks a lot.

You can simply add a second OnTime function. Define the CONSTANT
SPLASH_MINUTES to be 7, and then add this code:

RunWhenSplash = Now + TimeSerial(0, SPLASH_MINUTES, 0)
Application.OnTime RunWhenSplash, "ShowMySplash", , True

Public Sub ShowMySplash
ClosingSplashScreen.Show ' Modal or Not?
' Do something based on user response?
End Sub

Don't forget to cancel the second OnTime before you quit Excel:

Application.OnTime RunWhenSplash, "ShowMySplash", , False

HTH,

Eric

 

[ordnance1]

An additional question

In your post you said I should remember to cancel the second OnTime before I
quite Excel. So I added the line below to my BeforeClose routine, but I get
an error Method 'OnTime' of object'_Application failed.


Application.OnTime RunWhenSplash, "ShowMySplash", , False

 

[ordnance1]

Solved

An additional question

In your post you said I should remember to cancel the second OnTime before
I quite Excel. So I added the line below to my BeforeClose routine, but I
get an error Method 'OnTime' of object'_Application failed.


Application.OnTime RunWhenSplash, "ShowMySplash", , False