Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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, procedu="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, procedu="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, procedu="StartTimer2", schedule:=False MsgBox "Timer2 is gestopt" End Sub Sub StopTimer1() On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedu="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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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, _ Procedu="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, _ Procedu="PrintenOpTijd", Schedule:=True End Sub Public Sub StopTimer1() On Error Resume Next Application.OnTime EarliestTime:=RunWhen1, _ Procedu="StartTimer2", Schedule:=False 'MsgBox "Timer1 is gestopt" End Sub Public Sub StopTimer2() On Error Resume Next Application.OnTime EarliestTime:=RunWhen2, _ Procedu="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. In article , "Peter Pantus" wrote: Here is the code The message boxes are in Dutch. I hope that is not a problem Many Thanks in advance |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Find %ontime & SUMIF ontime ie: find matching sets within Range... | Excel Worksheet Functions | |||
.ontime | Excel Discussion (Misc queries) | |||
OnTime VB | Excel Discussion (Misc queries) | |||
OnTime VB | Excel Worksheet Functions | |||
OnTime problem | Excel Programming |