Application.Ontime Verzögerung bei Inaktivität
15.05.2025 14:11:01
DoktorExcel
Seit einem Windows- oder Office-Update (ich weiß nicht welches) funktioniert dies nicht mehr zuverlässig. Application.Ontime wird teilweise nur mit vielen Sekunden Verzögerung ausgeführt.
Beispiel (siehe beigefügte Datei):
https://www.herber.de/bbs/user/177459.xlsm
Details:
Beim Starten des Codes wird mittels Application.Ontime nach 1 Sekunde das Unterprgamm "Ontime" gestartet. Dieses gibt die Sollzeit, die Istzeit, die Dauer sowie die Verspätung in der Tabelle aus. Am Ende des Unterprogramms wird die Soll-Startzeit (EarliestTime) um eine Sekunde hochgesetzt und Application.Ontime neu gestartet.
Zunächst arbeitet das Programm wie gewünscht. Nach ca. 10 Sekunden wird das Unterprogamm aber nicht mehr jede Sekunde, sondern nur noch alle 5 Sekunden aufgerufen und holt anschließend die verpassten Aufrufe (4x) nach. Nach einer Minute erhöht sich das Intervall auf 20 Sekunden, und auch hier werden dann die fehlenden 19 Aufrufe nachgeholt.
Der Effekt lässt sich abstellen, indem man die Maus bei aktiviertem Excel-Fenster (Tabelle oder VBA-Editor) bewegt. Dann erfolgt der Aufruf wieder im Sekundentakt, solange man die Maus bewegt.
Es erscheint also so, als ob Excel wg. vermeintlicher Inaktivität keine Rechenzeit für Application.Ontime zu Verfügung gestellt würde (von Windows? Von Excel?).
Wenn man dagegen in einer Endlosschleife während der Ausführung dauernd DoEvents aufruft (siehe auskommentierten Code), also sozusagen Excel beschäftigt hält, funktioniert der Aufruf einmal pro Sekunde. Allerdings geht dadurch die CPU-Auslastung von 1% auf >14% hoch.
Der Zyklus lässt sich durch Anklicken von Stopp beenden.
Ich verwende Office 365 Business mit Windows 11 Pro Version 24H2.
Der Effekt tritt auf mehreren Rechnern auf (auch bei Windows 10 Pro Version 2009).
Hat jemand eine Idee, woran das liegen könnte und wie man es beheben kann?
Dim tt1 As Single
Dim tt2 As Single
Dim Zeit As Date
Dim Intervall As Long
Dim Stopp As Boolean
Sub Start() ' Zum Starten der regelmäßigen Ausgabe
Intervall = 1 ' in Sekunden
' Ausgabe löschen
Range("A4:D10000").Select
Selection.ClearContents
With Range("A4:D10000").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' Ausgabe vorbereiten
iZeile = 4
' Zeit für erste Ausführung berechnen
Zeit = Now + Intervall / 24 / 3600
tt1 = Timer ' Zeitstempel speichern
Stopp = False
' Zyklus anstoßen
Application.Ontime Zeit, "Ontime"
' Wenn man diesen Code ausführen lässt, funktioniert der regelmäßige Aufruf. Allerdings frisst Excel dann sehr viel Rechenzeit, die anderweitig benötigt wird
' While Not Stopp
' DoEvents
' Wend
End Sub
Sub Stoppen() ' Zum Beenden des regelmäßigen Aufrufens
Stopp = True
End Sub
' Unterprogramm, das regelmäßig mittels Application.Ontime ausgeführt werden soll
Sub Ontime()
' Ausgabe der Soll-Zeit für die Ausführung
Cells(iZeile, 1) = Zeit
' Ausgabe der Ist-Zeit der Ausführung
Zeit2 = Now
Cells(iZeile, 2) = Zeit2
' Ausgabe der Dauer des Zyklus
tt2 = Timer
Cells(iZeile, 3) = tt2 - tt1
If tt2 - tt1 - Intervall > 0.3 Then
With Cells(iZeile, 3).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
tt1 = tt2
' Ausgabe der Verspätung
Cells(iZeile, 4) = (Zeit2 - Zeit) * 24 * 3600
' Zeile Hochzählen
iZeile = iZeile + 1
' Scrollen des Bildschirms erzwingen
Rows(iZeile).Select
' Diese Zeilen haben keine Verbesserung gebracht
' Rows(iZeile).Activate
' DoEvents
' Nächste Start-Zeit berechnen
Zeit = Zeit + Intervall / 24 / 3600
If Not Stopp Then ' Wenn nicht Stopp gedrückt wurde
' Neuen Zyklus anstoßen
Application.Ontime Zeit, "Ontime"
End If
End Sub
Anzeige
