Timer question

O

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
 
J

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
 
E

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
 
O

ordnance1

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


EricG said:
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
 
O

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
 
O

ordnance1

Solved

ordnance1 said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Conflicting VBA Coding 7
Impossible? - Close code 1
Time close and save 0
Close help 2
Help! Combine Macros 2
RunWhen error 4
Code Stopped 2
Excel can't find macro 2

Top