Dialog automatisch schließen

[volti]

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.

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

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

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

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

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

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

[volti]

Ergänzend:
Im Teil 2, Message an das Vordergrundfenster, sollte eigentlich PostMessageA statt SendMessageA stehen. 
Zwar funktioniert es auch mit SendMessageA, aber die Message WM_CLOSE sollte besser in der Warteschleife postiert werden und nicht direkt gesendet werden.
Gruß Karl-Heinz