From: ordnance1 on
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

From: joel on

Change the ONTIME timer to 1 minute instead of 10 minutes. Then count
ther number of 1 minute events to determine when 3 minutes are left like
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 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

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


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=205110

http://www.thecodecage.com/forumz

From: EricG on
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" wrote:

> 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
>
From: ordnance1 on
I will give that a try tomorrow. Thanks a lot.


"EricG" <EricG(a)discussions.microsoft.com> wrote in message
news:6A62F6C5-3535-457E-8652-A165EC2FCD19(a)microsoft.com...
> 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" wrote:
>
>> 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
>>
From: ordnance1 on
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" <ordnance1(a)comcast.net> wrote in message
news:#FBk2Wj$KHA.4308(a)TK2MSFTNGP04.phx.gbl...
> I will give that a try tomorrow. Thanks a lot.
>
>
> "EricG" <EricG(a)discussions.microsoft.com> wrote in message
> news:6A62F6C5-3535-457E-8652-A165EC2FCD19(a)microsoft.com...
>> 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" wrote:
>>
>>> 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
>>>