Notlösung per API
14.08.2009 18:14:48
Nepumuk
Hallo,
so sollte es auf alle Fälle gehen:
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType 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 MB_DEFBUTTON1 = &H0&
Private Const MB_DEFBUTTON2 = &H100&
Private Const MB_DEFBUTTON3 = &H200&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONHAND = &H10&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONSTOP = MB_ICONHAND
Private Const MB_OK = &H0&
Private Const MB_OKCANCEL = &H1&
Private Const MB_YESNO = &H4&
Private Const MB_YESNOCANCEL = &H3&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_RETRYCANCEL = &H5&
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC_CLASSNAMEMSDIALOGS = "#32770"
Private Const WM_CLOSE = &H10
Private Const strBoxTitle = "Information"
Private lngxlhWnd As Long
Public Sub prcMsgBox_Time2()
lngxlhWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
Call SetTimer(lngxlhWnd, 0&, 2000&, AddressOf prcTimer) '2000 Millisekunden
Call MessageBox(lngxlhWnd, "Diese Meldung schließt sich selbst.", strBoxTitle, _
MB_OK Or MB_ICONINFORMATION)
End Sub
Private Sub prcKillBox()
Call PostMessage(FindWindow(GC_CLASSNAMEMSDIALOGS, strBoxTitle), WM_CLOSE, 0&, 0&)
End Sub
Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Call prcKillTimer
Call prcKillBox
End Sub
Private Sub prcKillTimer()
Call KillTimer(lngxlhWnd, 0&)
End Sub
Gruß
Nepumuk