Button in Dialogbox automatisch anklicken

[volti]

Hallo,

erwartet man im Ablauf seines Codes eine auftauchende Dialogbox, die die Betätigung einer Schaltfläche erfordert, bevor der Code weiterläuft, kann man diese auch per VBA betätigen lassen.
Ansonsten würde der Programmablauf ja solange gestoppt, bis der User eine Schaltfläche klickt.

Denkbar, diesen Klick durchzuführen, wäre eine Möglichkeit mit Sendkeys (Tab,Return usw., m.E. aber sehr sehr unsicher) oder per Mouseevent einen Mausklick ausführen zu lassen.
Für die Mausversion benötigt man dann allerdings die genaue Position in der Dialogbox. Ggf. sind diese aus den Bildschirmkoordinaten umzurechnen, da sich die Dialogbox verschieben könnte.

Eine bessere Variante ist jedoch, den gewünschten Button in der DialogBox direkt anzusprechen.
Hierfür senden wir dem Button eine BM_Click-Message.

Auch hierfür gibt es wieder mehrere Möglichkeiten:

• Über die ID des gewünschten Buttons. Diese muss jedoch bekannt sein. (Ggf. über ein Spy-Programm ermitteln)
• Über den Buttontext. (wenigste Arbeit, etwas mehr Code)
  

Das warten auf die entsprechende Dialogbox kann man bei externen Programmen u.a. in einer Schleife machen.
Wird die Dialogbox innerhalb des VBA-Codes erzeugt (z.B. Aufruf einer Function, die wiederum ggf. eine Bestätigungsdialogbox generiert), müssen wir per Timer einen Parallelcode erzeugen, da VBA ja ansonsten nicht weiterläuft.

PS: Den Timer löschen wir sofort bei Abarbeitung der Callbackfunktion für eine einmalige Prüfung oder erst später nach Ausführung der Aktion, wenn eine dauerhafte Prüfung notwendig sein sollte.

Hier ein Beispiel über die ID:

Code:

Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
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 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 FindWindowA Lib "user32" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr

Dim mhTimer As LongPtr

Private Sub DlgClickProc()
' Klickt den gewünschten Button an
  Dim hDlg As LongPtr

  hDlg = FindWindowA("#32770", "SAP Meldung")  ' MsgBox-Anzeige abfangen
  If hDlg > 0 Then
     SendDlgItemMessageA hDlg, 2, &HF5, 0&, 0& ' 6=ja, 2=nein/OK
     KillTimer 0&, mhTimer                     ' Timer abschalten
  End If
End Sub

' ############# Aufruftest ################
Private Sub ClickButtonTest()
' VBA-Code SAP, vor der MsgBox
  On Error GoTo Fehler                          ' Zur Sicherheit...
  mhTimer = SetTimer(0&, 0&, 50, AddressOf DlgClickProc)
' VBA-Code SAP, der die Msgbox generiert
Fehler:
  KillTimer 0&, mhTimer                         ' Timer zur Sicherheit abschalten
' VBA-Code SAP, nach der MsgBox
End Sub

Und hier noch ein Beipsiel über den Buttontext:

Code:

Option Compare Text
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 msButtontext As String, mhTimer As LongPtr

Private Sub DlgClickProc()
  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 msButtontext 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)
  msButtontext = "nein"
  MsgBox MsgBox("Bitte einen Button klicken", vbYesNo, "Test")
'  KillTimer 0&, mhTimer: mhTimer = 0                              ' Timer löschen
End Sub

_________
viele Grüße
Karl-Heinz