Msgbox verschieben und zeitgesteuert schließen

Gleiches Prinzip wie in vba004.htm. Zwei Timer starten, Msgbox anzeigen, Handle ermitteln, Msgbox verschieben, Handle "Ja" oder "Nein" ? Button ermitteln, Klick darauf simulieren.

Beispieldatei msgboxclose.zip 28 kB

'*************************************
'* AddressOf
'* Ausgeknobelt von K. Getz und M. Kaplan
'*************************************

Private Declare Function GetVbaProjekt _
  Lib "vba332.dll" Alias "EbGetExecutingProj" _
  (hVBA As Long) As Long

Private Declare Function GetFunktionsnummerString _
  Lib "vba332.dll" Alias "TipGetFunctionId" _
  (ByVal hVBA As Long, ByVal strFuncNameUnicode _
  As String, strFunktionsnummer As String) As Long

Private Declare Function GetFunktionsnummerLong _
  Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _

(ByVal hVBA As Long, ByVal strFunktionsnummer _
  As String, hlngFunction As Long) As Long

'************************************

Private Declare Function SetTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc _
  As Long) As Long

Private Declare Function KillTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

'************************************

Private Declare Function FindWindow Lib "user32" Alias _
  "FindWindowA" (ByVal lpClassName As String, _
  ByVal lpWindowName As String) 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

'*************************************

Private Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
  Alias "GetWindowTextA" (ByVal hwnd As Long, _
  ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function PostMessage Lib "user32" _
  Alias "PostMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, _
  ByVal lParam As Long) As Long

Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private hlngTimerKennung As Long
Private hlngTimerKennung1 As Long
Private Const strTitel = "AutoSchließenVerschieben"

Public Sub MsgBoxTest()
  SetMyTimer hlngTimerKennung1, 5000, "ApiTimer"
  SetMyTimer hlngTimerKennung, 50, "ApiTimer"
  MsgBox "Anzeigen der MSGBOX", vbYesNo, strTitel
  TimerZerstören hlngTimerKennung
  TimerZerstören hlngTimerKennung1
End Sub

Private Sub ApiTimer(ByVal hwndOwner&, _
  ByVal lngWindowMessage&, _
  ByVal hlngRückTimerKennung&, _
  ByVal lngTickCount&)
  'Diese Funktion wird vom Timer aufgerufen. Jeder
  'Fehler hier, oder in den Sub Prozeduren hat
  'sehr unangenehme Folgen.
  If hlngRückTimerKennung = hlngTimerKennung Then
    'Der Win Timer liefert hier in der Callbackfunktion
    'unter hlngRückTimerKennung eine Kennung, die beim
    'erzeugen als Handle geliefert wurde. Damit lassen
    'sich die Timer unterscheiden.
    TimerZerstören hlngTimerKennung
    MsgboxVerschieben
  End If
  If hlngRückTimerKennung = hlngTimerKennung1 Then
    TimerZerstören hlngTimerKennung1
    MsgboxSchließen
  End If
End Sub

Private Sub MsgboxVerschieben()
Dim hwnd&, hwnd1&, lngRück&, Beschriftung$
  hwnd = FindWindow("#32770", strTitel)
  'Ein Handle auf die MsgBox wird geliefert
  If hwnd <> 0 Then
    'SetWindowPos hwnd, 0, X-Pos., Y-Pos., 0, 0, 1
    SetWindowPos hwnd, 0, 200, 100, 0, 0, 1
    'MsgBox wird verschoben
  End If
End Sub

Private Sub TimerZerstören(Timerkennung As Long)
  'Der Timer wird zerstört
  If Timerkennung <> 0 Then _
    KillTimer 0, Timerkennung
End Sub

Private Sub SetMyTimer(Timerkennung As Long, Zeit As Long, _
  Callbackname As String)
  'hlngTimerKennung(1) ist eine auf Modulebene deklarierte
  'Variable, die als Referenz übergeben wird, um ein Handle
  'auf einen erzeugten Timer zurückzuliefern (Timerkennung).
  'Zeit in Millisekunden.
  'Callbackname ist der Name der Callbackfunktion, die vom
  'Windows Timer aufgerufen wird.
  Timerkennung = SetTimer(0, 0, Zeit, _
    GetFuncAdress(Callbackname))
End Sub

Private Sub MsgboxSchließen()
Dim hwnd&, hwnd1&, lngRück&, Beschriftung$
  On Error Resume Next
  hwnd = FindWindow("#32770", strTitel)
  'Ein Handle auf die MsgBox wird geliefert
  hwnd1 = GetWindow(hwnd, GW_CHILD)
  'Ein Handle auf ein Kindfenster der MsgBox
  Do
    Beschriftung = String(255, 0)
    'Buffer für Fenstertext
    lngRück = GetWindowText(hwnd1, Beschriftung, 250)
    Beschriftung = Left$(Beschriftung, InStr(1, _
      Beschriftung, Chr(0)) - 1)
    'Fenstertext wird geholt
    ' If LCase(Beschriftung) = "&nein" Then
    If LCase(Beschriftung) = "&ja" Then
      'Wenn Fenster Beschriftung Ja hat
      PostMessage hwnd1, WM_LBUTTONDOWN, 0, 0
      PostMessage hwnd1, WM_LBUTTONUP, 0, 0
      'Mausklick wird simuliert
    End If
    hwnd1 = GetWindow(hwnd1, GW_HWNDNEXT)
    'Nächstes Fenster auf gleicher Ebene holen
  Loop While hwnd1 <> 0

End Sub

'*************************************
'* AddressOf
'* Ausgeknobelt von K. Getz und M. Kaplan
'*************************************

Public Function GetFuncAdress&(strFunktion$)
Dim hVBA&, lngRück&, strFunktionsnummer$
Dim hlngFunction&, strFuncNameUnicode$
  strFuncNameUnicode = StrConv(strFunktion, vbUnicode)
  GetVbaProjekt hVBA
  If hVBA <> 0 Then
    lngRück = GetFunktionsnummerString(hVBA, _
      strFuncNameUnicode, strFunktionsnummer)
    If lngRück = 0 Then
      lngRück = GetFunktionsnummerLong(hVBA, _
        strFunktionsnummer, hlngFunction)
      If lngRück = 0 Then GetFuncAdress = _
        hlngFunction
    End If
  End If
End Function