vielleicht so, mit API u. WshShell.Popup
18.06.2010 17:34:18
Tino
Hallo,
hier mal eine Version die bei ersten Tests sehr vielversprechend aussieht.
Option Explicit
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 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 KillTimer Lib "user32.dll" ( _
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
Const FLAGS = 2 Or 1
Const HWND_TOPMOST = -1
Dim strMSG_Titel$, lngTimer&
Sub Msg_Foreground()
Dim L_hWnd As Long
L_hWnd = FindWindow(vbNullString, strMSG_Titel)
If L_hWnd <> 0 Then _
KillTimer 0&, lngTimer: _
SetWindowPos L_hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Sub
Sub test()
Dim WshShell As Object
Dim intMSGBOX As Integer
lngTimer = SetTimer(0&, 0&, 50, AddressOf Msg_Foreground)
Set WshShell = CreateObject("WScript.Shell")
strMSG_Titel = "Test MSGB" 'Titel der Msgbox
'**************************************************************
'Syntax Popup(Text,[Timer in Sekunden],[Titel],[Value Button])
intMSGBOX = WshShell.Popup("Test Nachricht", 0, strMSG_Titel, 64)
'Value Button
'0 OK
'1 OK , Cancel
'2 Abort , Ignore, Retry
'3 Yes , No, Cancel
'4 Yes , No
'5 Retry , Cancel
'16 Critical
'32 Question
'48 Exclamation
'64 Information
'**************************************************************
KillTimer 0&, lngTimer
strMSG_Titel$ = "": lngTimer = 0
End Sub
Gruß Tino