AW: VBA - externe MsgBox mit SendKeys bestätigen
15.06.2007 16:43:13
Nepumuk
Hallo Nora,
kommst du damit zurecht?
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call prcTimerStop
End Sub
Private Sub Workbook_Open()
Call prcTimerStart
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function EnumWindows Lib "user32.dll" ( _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Boolean
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" ( _
ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal wIndx As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC_CLASSNAMEMSDIALOGS = "#32770"
Private Const GWL_STYLE = -&H10
Private Const WS_VISIBLE = &H10000000
Private Const WS_BORDER = &H800000
Private Const WM_CLOSE = &H10
Private llngxlhWnd As Long
Public Sub prcTimerStart()
llngxlhWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
SetTimer llngxlhWnd, 0&, 500&, AddressOf prcTimer
End Sub
Public Sub prcTimerStop()
KillTimer llngxlhWnd, 0&
End Sub
Private Sub prcTimer(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
EnumWindows AddressOf fncWindows, ByVal 0&
End Sub
Private Function fncWindows(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim strCaption As String, strClassname As String
Dim lngStyle As Long, lngReturn As Long
strClassname = String$(255, "0")
lngReturn = GetClassName(hwnd, strClassname, 255&)
strClassname = Left$(strClassname, InStr(1, strClassname, Chr(0)) - 1)
If strClassname = GC_CLASSNAMEMSDIALOGS Then
lngStyle = GetWindowLong(hwnd, GWL_STYLE) And (WS_VISIBLE Or WS_BORDER)
lngReturn = GetWindowTextLength(hwnd)
If lngStyle = (WS_VISIBLE Or WS_BORDER) And lngReturn <> 0 Then
strCaption = Space(lngReturn)
GetWindowText hwnd, strCaption, lngReturn + 1
If Left$(strCaption, 10) = "Fehler Nr." Then PostMessage hwnd, WM_CLOSE, 0&, 0&
End If
End If
fncWindows = True
End Function
Das Programm läuft parallel zu deinem und schließt jede Msgbox mit dieser Caption.
Gruß
Nepumuk