Application.OnTime ignorriert Stop

Sub Workbook_Open()
'Starte inaktivitäts Timer
Call StartTimerPendenz
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Automatisch speichern beim beenden
If Not Saved Then Save
'Timer Anhalten
Call StopTimerPendenz
End Sub

Option Explicit
Dim NotClose As Boolean
Dim t1 As Single, t2 As Single
Dim nForeColor As Long
Dim nBackColor As Long
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Dim hwnd As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Dim hwnd As Long
#End If
Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const Warten = 15
'von GraFri auf www.herber.de
Sub FensterPosition(ByVal strTitel As String, Modus As Boolean)
hwnd = FindWindow(vbNullString, strTitel)
If hwnd = 0 Then
MsgBox "Fenster wurde nicht gefunden!"
Exit Sub
End If
If Modus = True Then
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
Else
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS
End If
End Sub
Private Sub UserForm_Initialize()
If ThisWorkbook.Saved Then
CommandButton2.Caption = "Jetzt schließen" '& vbLf & "(Datei ist gespeichert)"
Else
CommandButton2.Caption = "Jetzt schließen"
End If
'Standartfabe des Buttons wird genutzt
nForeColor = NichtSchliessen.ForeColor
nBackColor = NichtSchliessen.BackColor
'Standartfabe des Buttons wird genutzt
nForeColor = CommandButton2.ForeColor
nBackColor = CommandButton2.BackColor
End Sub
Private Sub CommandButton2_Click()
NotClose = False
t2 = Timer
End Sub
Private Sub UserForm_Activate()
hwnd = FindWindow("ThunderDFrame", Me.Caption)
FensterPosition Me.Caption, True
SetWindowLong hwnd, HWND_TOPMOST, GetWindowLong(hwnd, GWL_STYLE) And Not WS_SYSMENU
DrawMenuBar hwnd
End Sub
Function Abbruch() As Boolean
t1 = Timer
t2 = Timer + Warten
On Error Resume Next
Me.Show vbModeless
If Err.Number = 0 Then
Do
Label1.Caption = "Die Pendenzen werden in " & Warten - Int(Timer - t1) & " Sekunden" & vbLf & "geschlossen..."
DoEvents
Loop Until Timer > t2
End If
Abbruch = NotClose
Unload Me
End Function
Private Sub NichtSchliessen_Click()
NotClose = True
t2 = Timer
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
Private Sub NichtSchliessen_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'Farbe des Buttons wird gewechselt
NichtSchliessen.ForeColor = RGB(255, 255, 255)
NichtSchliessen.BackColor = RGB(255, 128, 0)
End Sub
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'Farbe des Buttons wird gewechselt
NichtSchliessen.ForeColor = nForeColor
NichtSchliessen.BackColor = nBackColor
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'Farbe des Buttons wird gewechselt
CommandButton2.ForeColor = RGB(255, 255, 255)
CommandButton2.BackColor = RGB(255, 128, 0)
End Sub
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'Farbe des Buttons wird gewechselt
CommandButton2.ForeColor = nForeColor
CommandButton2.BackColor = nBackColor
End Sub

Option Explicit
Public Const SchließenNach = "00:05:00" 'Autom. Schließen nach dieser Zeit
Dim datA As Date 'für AutoSchließen-Prozedur
Sub StartTimerPendenz()
On Error Resume Next
Application.OnTime EarliestTime:=datA, Procedure:="AutoSchliessen", Schedule:=False
datA = Now + CDate(SchließenNach)
If ThisWorkbook.ReadOnly = False Then
Application.OnTime datA, "AutoSchliessen"
End If
End Sub
'Auto-Prozedur löschen
Sub StopTimerPendenz()
On Error Resume Next
Application.OnTime EarliestTime:=datA, Procedure:="AutoSchliessen", Schedule:=False
End Sub
'Auto-Prozedur nach Zeitablauf
Sub AutoSchliessen()
If SchliessenWarnung.Abbruch = False Then
Workbooks("Pendenzen.xlsm").Close True
Else
StartTimerPendenz
End If
End Sub