OnTime Problem

  • Thread starter Thread starter Peter Pantus
  • Start date Start date
P

Peter Pantus

Dear J.E.

Perhaps I wasn't clearly enough
I have a sheet that is 24 hours open
I would like to print the sheet between 05:00 and 08:00 o'clock
The user must fill in the correct data in the sheet before he can print it.
So between 05:00 and 08:00 he gets every 15 min a message
Timer1 starts the clock at 05:00 [til 08:00]
Timer2 starts 15 min later then Timer1 and comes back every 15 min until it
is 08:00 o'clock
At 08:00 both timers must be stopped.
Both timers must also be stopped when I close the workbook.

J.E. McGimpsey said:
Can't tell from that code.
Click to expand...
Dear J.E.
 
Please any help,

Im using XP and Excel 2000
When I run StopTimer() and I close the workbook, the workbook opens itself.
I cannot stop the timer. I've usted the right time to stop the timer.

When I delete the On Error Resume Next line I get a error message "Methode
OnTime van object_Application is mislukt"
Can anyone tell me what I'm doing wrong??

Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
 
Can't tell from that code.

If you're using the rest of Chip's code as he demonstrates, it
shouldn't give you the error, so I'd go back an look at his examples.

Re-opening the workbook sounds like you may be calling OnTime more
than once before the first time to fire, so that StopTimer is only
catching one of the multiple calls. Or perhaps your code isn't
properly updating RunWhen.

The error when you remove the On Error statement would seem to
indicate that RunWhen or cRunWhat was not being set correctly, or
that StopTimer was being called more than once (so that the first
time killed the RunWhen event, and the second one threw the error,
since there was no longer a scheduled event at that time).

Pure speculation without seeing your other code, though...
 
in order to cancel an ontime you need to know the EXACT scheduled time
and the procedure name thus you need to store them in a variable.

By using 1 collection for all timed procedures, you just run the
stoptimers in the close event of your workbook.


Like:

Dim MyTimers As New Collection

Sub StopTimers()
On Error Resume Next
For Each itm In MyTimers
Application.OnTime itm(0), itm(1), , False
Next
On Error GoTo 0
End Sub

Sub LoadTimed()
On Error Resume Next
MyTimers.Remove "MyProc"
On Error GoTo 0
MyTimers.Add Array(Now + TimeSerial(0, 0, 5), "MyProc"), "MyProc"
Application.OnTime MyTimers("MyProc")(0), MyTimers("MyProc")(1)
End Sub


Sub MyProc()
'do your stuff
beep
'reschedule
LoadTimed
End Sub







keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
Peter,

The most likely explanation is that RunWhen and cRunWhat are not declared as
module level variables.
Ensure they are by declaring them as

Dim RunWhen As Variant
Dim cRunWhat As String

outside of the macros in the module.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Or perhaps I wasn't - you need to post the code.

From your description, it's obvious that you need two sets of global
variables. It's not obvious that you have them.
 
J.E.

Here is the code
The message boxes are in Dutch. I hope that is not a problem
Many Thanks in advance


Public RunWhen As Double
Public Const cRunIntervalSeconds = 15 ' two minutes
Public Const cRunWhat = "The_Sub"
Public x
Public y


Sub StartTimer1()
'StartTimer1 start vanaf 05:00 uur
MsgBox "Timer1 gestart"
RunWhen = TimeSerial(5, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:="StartTimer2",
schedule:=True
End Sub

Sub StartTimer2()
'StartTimer2 start als StartTimer1 om 05:00 uur geactiveerd is geworden
'De Timer functie wordt overgegeven aan Timer2
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:="PrintenOpTijd",
schedule:=True
End Sub

Sub PrintenOpTijd()
If Format(Now, "hh:mm") > "05:00" And Format(Now, "hh:mm") < "05:02" Then
Response = MsgBox("Zijn alle gegevens ingevuld?" & Chr(13) & Chr(13) & _
"* Druk YES indien alle gegevens zijn ingevuld." & Chr(13) & _
" De dagstaat wordt afgedrukt en de datum wordt aangepast" &
Chr(13) & Chr(13) & _
"* Druk NO indien nog gegevens moeten worden toegevoegd" & Chr(13) &
_
" Achter 10 min ben ik terug", vbYesNo)
If Response = vbYes Then
Printen
StopTimer2
Exit Sub
End If
ElseIf Format(Now, "hh:mm") > "05:02" Then
StopTimer2
Exit Sub
End If
StartTimer2
End Sub

Sub StopTimer2()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, procedure:="StartTimer2",
schedule:=False
MsgBox "Timer2 is gestopt"
End Sub
Sub StopTimer1()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, procedure:="StartTimer1",
schedule:=False
MsgBox "Timer1 is gestopt"
End Sub

Sub Printen()

If Time > #5:00:00 AM# And Time < #8:00:00 AM# Then
Response = MsgBox("Na het printen wordt de datum aangepast" & Chr(13) &
_
"aan een nieuwe dag [momentele datum]" & Chr(13) & _
"Weet je zeker dat je verder wilt", vbYesNo + vbCritical, "Printen
Dagstaat")
If Response = vbYes Then
AantalSheets = Worksheets.Count
For pSheetNummer = 1 To AantalSheets
Worksheets(pSheetNummer).Select
If ActiveSheet.Name = "KALD Ber" Then
pDIR = "Hydin\"
pZoom = 90
pActiveSheet = "KALD Ber"
pCelDatum = "V1"
End If

If ActiveSheet.Name = "KALD Zuiv" Then
pDIR = "Zuivering\"
pZoom = 100
pActiveSheet = "KALD Zuiv"
pCelDatum = "Q1"
End If

WriteDagstaatKALD 'Bewaar eerst de
huidige gegevens
With ActiveSheet.PageSetup 'Print de sheet 2 maal
.Zoom = pZoom
End With
' ActiveWindow.SelectedSheets.PrintOut Copies:=2,
Collate:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True,
Collate:=True
MsgBox "Printen"
ActiveSheet.Unprotect password:="p"
Set vs = Workbooks("Kald.xls").Sheets(pActiveSheet)
Range(pCelDatum) = Now
ActiveSheet.Protect password:="p"
Next pSheetNummer
Else
If Response = vbNo Then Exit Sub
End If
Else
MsgBox "Er kan alleen geprint worden tussen 05:00 en 08:00 uur"
End If
End Sub
 
Looks to me that these modifications will work:

Public RunWhen1 As Double
Public RunWhen2 As Double

Public Sub StartTimer1()
'StartTimer1 start vanaf 05:00 uur
'MsgBox "Timer1 gestart"
RunWhen1 = TimeSerial(5, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen1, _
Procedure:="StartTimer2", Schedule:=True
End Sub

Public Sub StartTimer2()
'StartTimer2 start als StartTimer1 om 05:00 uur
'geactiveerd is geworden
'De Timer functie wordt overgegeven aan Timer2
RunWhen2 = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen2, _
Procedure:="PrintenOpTijd", Schedule:=True
End Sub

Public Sub StopTimer1()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen1, _
Procedure:="StartTimer2", Schedule:=False
'MsgBox "Timer1 is gestopt"
End Sub

Public Sub StopTimer2()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen2, _
Procedure:="PrintenOpTijd", Schedule:=False
'MsgBox "Timer2 is gestopt"
End Sub

Note that the procedures called in the StopTimerN() subs are (and
have to be) the same ones called in the StartTimerN() subs.

From your description, I suspect that StartTimer1() should set
RunWhen1 to

TimeSerial(5, 0, 0)

so that StartTimer2 is called at 5:00:00 rather than 5:00:15.

Also, I didn't see anything that called StartTimer1, which would be
required if you want this code to cycle every day.
 
Back
Top