AW: Application.OnTime aus UserForm heraus nutzen
07.12.2010 15:58:35
Tino
Hallo,
kannst mal so testen, habe ich jetzt nicht ausgiebig getestet.
kommt als Code in UserForm1
Option Explicit
Dim Time1 As Date, Time2 As Date, Time3 As Date
Private Sub UserForm_Activate()
Time1 = TimeSerial(6, 0, 0)
Time2 = TimeSerial(14, 0, 0)
Time3 = TimeSerial(22, 0, 0)
Time1 = Date + Time1 - IIf(Time1 < Time, 0, 1)
Time2 = Date + Time2 - IIf(Time2 < Time, 0, 1)
Time3 = Date + Time3 - IIf(Time3 < Time, 0, 1)
Start_Timer
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
With Application
.OnTime Time1, "'Save_ThisWorkbook 1'", Schedule:=False
.OnTime Time2, "'Save_ThisWorkbook 2'", Schedule:=False
.OnTime Time3, "'Save_ThisWorkbook 3'", Schedule:=False
End With
End Sub
Sub Start_Timer(Optional IndexTimer As Integer = 0)
With Application
On Error Resume Next
.OnTime Time1, "'Save_ThisWorkbook 1'", Schedule:=False
.OnTime Time2, "'Save_ThisWorkbook 2'", Schedule:=False
.OnTime Time3, "'Save_ThisWorkbook 3'", Schedule:=False
On Error GoTo 0
Select Case IndexTimer
Case 1: Time1 = Time1 + 1
Case 2: Time2 = Time2 + 1
Case 3: Time3 = Time3 + 1
Case 4: Exit Sub
Case Else
Time1 = Time1 + 1
Time2 = Time2 + 1
Time3 = Time3 + 1
End Select
.OnTime Time1, "'Save_ThisWorkbook 1'"
.OnTime Time2, "'Save_ThisWorkbook 2'"
.OnTime Time3, "'Save_ThisWorkbook 3'"
End With
End Sub
kommt als Code in Modul
Option Explicit
Sub Save_ThisWorkbook(IndexTime As Integer)
With ThisWorkbook
If Not .ReadOnly Then
.Save
End If
End With
Call UserForm1.Start_Timer(IndexTime)
End Sub
Gruß Tino