22.07.2024, 14:30
Liebe Leserin, lieber Leser,
manchmal möchte man eine während des Programmablaufs auftauchende, lästige Dialogbox automatisch wegklicken, damit der Programmablauf nicht angehalten wird.
Um dieses automatisiert zu machen, gibt es eine Vielzahl von Lösungen auch via VBA.
Lösung 1:
Falls keine Rückmeldung ausgewertet werden soll, weil nur ein Button vorhanden ist oder es egal ist, was man klickt, senden wir der Dialogbox einfach eine Schließen-Message.
Für Sicherheit sorgt hier die Übergabe des Titelleistentextes, mit der die Dialogbox eindeutig identifiziert werden kann.
Wenn man sich sicher ist, dass keine weitere Dialogbox aktiv ist, kann man dem Fenster im Vordergrund auch einfach die Schließen-Message senden. Da braucht man dann keine Titelleistenvorgabe.
Natürlich klären wir vorher die Klasse ab, damit nicht aus Versehen möglicherweise Excel geschlossen wird.![Smile Smile](https://www.clever-excel-forum.de/images/smilies/smile.gif)
Hier ein paar Codebeispiele zum Thema:
Dialog mit Captiontext schließen
Dialog im Vordergrund schließen
Möchte man gezielt einen Button in der Dialogbox anklicken, weil für den weiteren Programmablauf der (vorgegebene) Wunsch des Users wichtig ist,
senden wir dem entsprechenden Button eine Klick-Message.
Die Identifizierung des Buttons in der Dialogbox können wir über den Buttontext (z.B. API-Funktionen FindWindowEx oder EnumChildWindows) vornehmen.
Dialog über Buttontext schließen
Dialog über Buttontext schließen (Enum)
Oder wir nehmen die ID des Buttons. Diese ist entweder bekannt oder muss ermittelt werden, z.B. über ein WindowSpy-Programm.
Hier ein mögliches Spy-Programm:
https://www.clever-excel-forum.de/Thread-Windows-Spy-und-Pixelfarben
Dialog über Button-ID schließen
Zum Abschluss:
Ist der Dialog bei Aufruf unseres Beenden-Programms noch nicht aktiv und wird erst in der Zukunft erwartet, müssen wir mit einen Timer periodisch prüfen, ob die Dialogbox bereits aktiv ist.
Hierzu bietet sich Applcation.OnTime an oder man nimmt noch besser den Windowstimer, der auch kleinste Periodenzyklen (mSec) erlaubt.
Der Timer wird bei jedem Aufruf gelöscht und wenn Dialog noch aktiv neu gestartet. Wer ganz sicher gehen möchte, dass der Timer auch in Fehlerfällen abgeschaltet ist,
löscht ihn nach Beendigung der 'DlgEndProc' noch mal extra:
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0
In der beigefügten Datei findest Du alle hier gezeigten und weitere Beispiele zum Thema.
Dialog_Beenden.xlsb (Größe: 41,48 KB / Downloads: 1)
Bitte auch beachten, dass nicht alle Methoden bei allen Dialogboxen immer funktionieren.
Es gibt Dialoge sozusagen als eigene Anwendung, Dialoge innerhalb externer Apps (Editor - Möchten Sie speichern) oder von VBA innerhalb Excel aufgerufene Msgboxen usw..
So, und nun viel Spaß und Erfolg beim Ausprobieren.
Karl-Heinz
manchmal möchte man eine während des Programmablaufs auftauchende, lästige Dialogbox automatisch wegklicken, damit der Programmablauf nicht angehalten wird.
Um dieses automatisiert zu machen, gibt es eine Vielzahl von Lösungen auch via VBA.
Lösung 1:
Falls keine Rückmeldung ausgewertet werden soll, weil nur ein Button vorhanden ist oder es egal ist, was man klickt, senden wir der Dialogbox einfach eine Schließen-Message.
Für Sicherheit sorgt hier die Übergabe des Titelleistentextes, mit der die Dialogbox eindeutig identifiziert werden kann.
Wenn man sich sicher ist, dass keine weitere Dialogbox aktiv ist, kann man dem Fenster im Vordergrund auch einfach die Schließen-Message senden. Da braucht man dann keine Titelleistenvorgabe.
Natürlich klären wir vorher die Klasse ab, damit nicht aus Versehen möglicherweise Excel geschlossen wird.
![Smile Smile](https://www.clever-excel-forum.de/images/smilies/smile.gif)
Hier ein paar Codebeispiele zum Thema:
Dialog mit Captiontext schließen
Code:
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function PostMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc2()
' Dialog beeenden mit WM_CLOSE
Dim hDlg As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
Call PostMessageA(hDlg, &H10, 0&, 0&): Exit Sub ' &H10 = WM_CLOSE
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc2)
End Sub
' ##### Test #####
Private Sub Test()
msDlgCaption = "Control Application 1.0": miStart = 0
Call DlgEndProc2
End Sub
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function PostMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc2()
' Dialog beeenden mit WM_CLOSE
Dim hDlg As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
Call PostMessageA(hDlg, &H10, 0&, 0&): Exit Sub ' &H10 = WM_CLOSE
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc2)
End Sub
' ##### Test #####
Private Sub Test()
msDlgCaption = "Control Application 1.0": miStart = 0
Call DlgEndProc2
End Sub
Dialog im Vordergrund schließen
Code:
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetClassNameA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc5()
' Dialog beeenden mit WM_CLOSE über Vordergrundfenster
Dim sTxt As String * 10
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
GetClassNameA GetForegroundWindow, sTxt, 10 ' Klassennamen holen
If Left$(sTxt, 6) = "#32770" Then
Call SendMessageA(GetForegroundWindow, &H10, 0&, 0&) ' &H10 = WM_CLOSE
Exit Sub
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 500, AddressOf DlgEndProc5)
End Sub
' ##### Test #####
Private Sub Test()
Call DlgEndProc5
End Sub
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetClassNameA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc5()
' Dialog beeenden mit WM_CLOSE über Vordergrundfenster
Dim sTxt As String * 10
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
GetClassNameA GetForegroundWindow, sTxt, 10 ' Klassennamen holen
If Left$(sTxt, 6) = "#32770" Then
Call SendMessageA(GetForegroundWindow, &H10, 0&, 0&) ' &H10 = WM_CLOSE
Exit Sub
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 500, AddressOf DlgEndProc5)
End Sub
' ##### Test #####
Private Sub Test()
Call DlgEndProc5
End Sub
Möchte man gezielt einen Button in der Dialogbox anklicken, weil für den weiteren Programmablauf der (vorgegebene) Wunsch des Users wichtig ist,
senden wir dem entsprechenden Button eine Klick-Message.
Die Identifizierung des Buttons in der Dialogbox können wir über den Buttontext (z.B. API-Funktionen FindWindowEx oder EnumChildWindows) vornehmen.
Dialog über Buttontext schließen
Code:
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String, msBtnCaption As String
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc4()
' Dialog beeenden mit BM_CLICK
Dim hDlg As LongPtr, hBtn As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
hBtn = FindWindowExA(hDlg, ByVal 0&, "Button", msBtnCaption)
If hBtn <> 0 Then
Call SendMessageA(hBtn, &HF5, 0&, 0&) ' &HF5 = BM_CLICK
Call SendMessageA(hBtn, &HF5, 0&, 0&): Exit Sub ' &HF5 = BM_CLICK 2x erforderlich
End If
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc4)
End Sub
' ##### Test #####
Private Sub Test()
' Achtung: Bei Buttontexten ggf. das Aktivierungkennzeichen & beachten
msDlgCaption = "Klick-Test": msBtnCaption = "&nein": miStart = 0
Call DlgEndProc4
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, msDlgCaption)
End Sub
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String, msBtnCaption As String
Dim mhTimer As LongPtr
Dim miStart As Long
Public Sub DlgEndProc4()
' Dialog beeenden mit BM_CLICK
Dim hDlg As LongPtr, hBtn As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
hBtn = FindWindowExA(hDlg, ByVal 0&, "Button", msBtnCaption)
If hBtn <> 0 Then
Call SendMessageA(hBtn, &HF5, 0&, 0&) ' &HF5 = BM_CLICK
Call SendMessageA(hBtn, &HF5, 0&, 0&): Exit Sub ' &HF5 = BM_CLICK 2x erforderlich
End If
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc4)
End Sub
' ##### Test #####
Private Sub Test()
' Achtung: Bei Buttontexten ggf. das Aktivierungkennzeichen & beachten
msDlgCaption = "Klick-Test": msBtnCaption = "&nein": miStart = 0
Call DlgEndProc4
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, msDlgCaption)
End Sub
Dialog über Buttontext schließen (Enum)
Code:
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Dim msBtnCaption As String
Dim mhTimer As LongPtr
Private Sub DlgClickProc()
If mhTimer = 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
EnumChildWindows GetForegroundWindow, AddressOf EnumButtonClick, 0 ' Buttons durchsuchen
End Sub
Function EnumButtonClick(ByVal hChild As LongPtr, ByVal lParam As LongPtr) As Long
' Alle Childs durchlaufen und Text und Klasse ermitteln
Dim sData As String * 255, sKlasse As String, sBtntext As String
GetClassNameA hChild, sData, 255 ' Klasse des Controls
sKlasse = Left$(sData, InStr(sData, vbNullChar) - 1)
' Hinweis: API GetWindowtext liefert bei Childs oft keine Werte!!!
SendMessageA hChild, &HD, 255, ByVal sData ' &HD = WM_GETTEXT ' Text des Controls
sBtntext = Replace(Left$(sData, InStr(sData, vbNullChar) - 1), "&", "")
If sBtntext Like msBtnCaption And sKlasse Like "Button" Then
SendMessageA hChild, &HF5, 0, 0 ' &HF5=BM_Click ' Button anklicken
EnumButtonClick = False
End If
EnumButtonClick = True
End Function
' ############# Aufruftest ################
Private Sub ClickButtonTest()
' Einen Button in einer Msgbox anklicken
mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgClickProc)
msBtnCaption = "nein"
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, "Test")
KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
End Sub
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Dim msBtnCaption As String
Dim mhTimer As LongPtr
Private Sub DlgClickProc()
If mhTimer = 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
EnumChildWindows GetForegroundWindow, AddressOf EnumButtonClick, 0 ' Buttons durchsuchen
End Sub
Function EnumButtonClick(ByVal hChild As LongPtr, ByVal lParam As LongPtr) As Long
' Alle Childs durchlaufen und Text und Klasse ermitteln
Dim sData As String * 255, sKlasse As String, sBtntext As String
GetClassNameA hChild, sData, 255 ' Klasse des Controls
sKlasse = Left$(sData, InStr(sData, vbNullChar) - 1)
' Hinweis: API GetWindowtext liefert bei Childs oft keine Werte!!!
SendMessageA hChild, &HD, 255, ByVal sData ' &HD = WM_GETTEXT ' Text des Controls
sBtntext = Replace(Left$(sData, InStr(sData, vbNullChar) - 1), "&", "")
If sBtntext Like msBtnCaption And sKlasse Like "Button" Then
SendMessageA hChild, &HF5, 0, 0 ' &HF5=BM_Click ' Button anklicken
EnumButtonClick = False
End If
EnumButtonClick = True
End Function
' ############# Aufruftest ################
Private Sub ClickButtonTest()
' Einen Button in einer Msgbox anklicken
mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgClickProc)
msBtnCaption = "nein"
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, "Test")
KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
End Sub
Oder wir nehmen die ID des Buttons. Diese ist entweder bekannt oder muss ermittelt werden, z.B. über ein WindowSpy-Programm.
Hier ein mögliches Spy-Programm:
https://www.clever-excel-forum.de/Thread-Windows-Spy-und-Pixelfarben
Dialog über Button-ID schließen
Code:
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" ( _
ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String, miBtnID As Long
Dim mhTimer As LongPtr
Dim miStart As Long
Private Sub DlgEndProc8()
' Dialog beeenden mit Button-ID für Buttonclick
Dim hDlg As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
SendDlgItemMessageA hDlg, miBtnID, &HF5, 0&, 0& ' &HF5 = BM_CLICK
Exit Sub
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc8)
End Sub
' ##### Test #####
Private Sub Test()
msDlgCaption = "Klick-Test": miBtnID = 6: miStart = 0 ' 6=ja, 7=nein
Call DlgEndProc8
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, msDlgCaption)
End Sub
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" ( _
ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim msDlgCaption As String, miBtnID As Long
Dim mhTimer As LongPtr
Dim miStart As Long
Private Sub DlgEndProc8()
' Dialog beeenden mit Button-ID für Buttonclick
Dim hDlg As LongPtr
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0 ' Timer löschen
If miStart = 0 Then miStart = Timer
If (Timer - miStart) > 10 Then Exit Sub ' Sicherheitsabbruch nach 10 Sek.
hDlg = FindWindowA("#32770", msDlgCaption) ' #32770 = Klasse von Dialogboxen
If hDlg <> 0 Then
SendDlgItemMessageA hDlg, miBtnID, &HF5, 0&, 0& ' &HF5 = BM_CLICK
Exit Sub
End If
If mhTimer = 0 Then mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgEndProc8)
End Sub
' ##### Test #####
Private Sub Test()
msDlgCaption = "Klick-Test": miBtnID = 6: miStart = 0 ' 6=ja, 7=nein
Call DlgEndProc8
MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, msDlgCaption)
End Sub
Zum Abschluss:
Ist der Dialog bei Aufruf unseres Beenden-Programms noch nicht aktiv und wird erst in der Zukunft erwartet, müssen wir mit einen Timer periodisch prüfen, ob die Dialogbox bereits aktiv ist.
Hierzu bietet sich Applcation.OnTime an oder man nimmt noch besser den Windowstimer, der auch kleinste Periodenzyklen (mSec) erlaubt.
Der Timer wird bei jedem Aufruf gelöscht und wenn Dialog noch aktiv neu gestartet. Wer ganz sicher gehen möchte, dass der Timer auch in Fehlerfällen abgeschaltet ist,
löscht ihn nach Beendigung der 'DlgEndProc' noch mal extra:
If mhTimer <> 0 Then KillTimer 0&, mhTimer: mhTimer = 0
In der beigefügten Datei findest Du alle hier gezeigten und weitere Beispiele zum Thema.
![.xlsb](https://www.clever-excel-forum.de/images/attachtypes/xlsb.png)
Bitte auch beachten, dass nicht alle Methoden bei allen Dialogboxen immer funktionieren.
Es gibt Dialoge sozusagen als eigene Anwendung, Dialoge innerhalb externer Apps (Editor - Möchten Sie speichern) oder von VBA innerhalb Excel aufgerufene Msgboxen usw..
So, und nun viel Spaß und Erfolg beim Ausprobieren.
Karl-Heinz