Wie kann ich mehrere Application.OnTime stoppen?
26.07.2014 07:21:10
Rene
Hallo,
ich habe ein kleines Problem mit einigen Application.OnTime ´s.
Ich habe ein Userform in den ich folgende Daten eintrage.
1 Checkbox ob aktiv oder nicht
1 Textfeld für Dateiname
3 Textfelder für die Startzeit (Format hh:mm:ss)
3 Felder wie lange die Datei ausgeführt wird (Format hh:mm:ss)
Diese Felder habe ich jeweils 4x. Über Excel lasse ich 2 Präsentationen
und 2 Youtube Videos in einem Arbeitsblatt zwischenspeichern, damit diese dann
später in der Reihenfolge
Präsentation
Video
Präsentation
Video
je nachdem ob aktiviert oder nicht starten kann.
Über Application.OnTime wird festgelegt wann und vor allem wie lange die Datei ausgeführt wird.
Bsp.
Public Sub Run_P1T()
If UserForm1.CheckBox1.Value = True Then
Dim EndeZeit As Date
praesent1 = Now + TimeValue(Sheets("Overview").Range("C6").Value & ":" & Sheets("Overview"). _
Range("D6").Value & ":" & Sheets("Overview").Range("E6").Value)
Application.OnTime praesent1, "Run_P1"
Else
ytstarter.Run_YT1T
End If
End Sub
Sub Run_P1()
Sheets("Start").Range("N25").Value = "läuft"
Dim ppApp As Object
Dim ppP As Object
Dim sFile As String
laufzeit = Now + TimeValue(Sheets("Overview").Range("C7").Value & ":" & Sheets("Overview").Range("D7").Value & ":" & Sheets("Overview").Range("E7").Value)
sFile = Sheets("Overview").Range("C5").Value
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set ppP = ppApp.Presentations.Open(sFile)
ppP.SlideShowSettings.Run
Application.Wait laufzeit
ppApp.Quit
Sheets("Start").Range("N25").Value = "gestoppt"
Set ppP = Nothing
Set ppApp = Nothing
Call ytstarter.Run_YT1T
End Sub
Das funktioniert auch alles super.
Mit dem Start der Youtube Videos ebenfalls, welche wie folgt aufgerufen werden:
Sub Run_YT1T()
If UserForm1.CheckBox3.Value = True Then
yt1time = Now + TimeValue(Sheets("Overview").Range("C16").Value & ":" & Sheets("Overview").Range("D16").Value & ":" & Sheets("Overview").Range("E16").Value)
Application.OnTime yt1time, "Run_YT1"
Else
FlexTimer.Run_P2T
End If
End Sub
Sub Run_YT1()
Sheets("Start").Range("N26").Value = "läuft"
Dim laufzeit As Double
laufzeit = Now + TimeValue(Sheets("Overview").Range("C17").Value & ":" & Sheets("Overview").Range("D17").Value & ":" & Sheets("Overview").Range("E17").Value)
Set IE = CreateObject("InternetExplorer.Application")
With IE
.MenuBar = 0
.Toolbar = 0
.StatusBar = 0
.navigate "http://www.youtube.com/embed/" & Sheets("Overview").Range("C14").Value & "?autoplay=1"
.Visible = 1
apiShowWindow IE.hwnd, SW_MAXIMIZE
End With
Application.Wait laufzeit
On Error GoTo weiter
IE.Quit
weiter:
Sheets("Start").Range("N26").Value = "gestoppt"
Set IE = Nothing
Call FlexTimer.Run_P2T
End Sub
Nun zu meinem eigentlichen Problem.
Da ich ja mehrere Application.OnTime verwende, benötige ich auch eine Stoppfunktion.
Ich habe versucht das ganze mittels
Application.OnTime praesent2, "Run_P2T", Schedule:=False
zu stoppen. Leider ohne Erfolg da ich immer einen Fehler erhalte.
Wie kann ich alle Application.OnTime stoppen lassen?
Also sprich:
Application.OnTime praesent1, "Run_P1"
Application.OnTime praesent2, "Run_P2"
Application.OnTime yt1time, "Run_YT1"
Application.OnTime yt2time, "Run_YT2"
Wäre super wenn ihr mir dabei helfen könntet.
Danke