Automatické ukončení dialogu MsgBox
V modulu deklarujte:
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 SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
KillTimer hWnd, idEvent
Select Case idEvent
Case NV_CLOSEMSGBOX 'chceme zavřít MsgBox po 4 vteřinách
Dim hMessageBox As Long
'Pro nalezení správného MsgBoxu změňte titulek
hMessageBox = FindWindow("#32770", "Automatický MsgBox")
If hMessageBox Then
Call SetForegroundWindow(hMessageBox)
SendKeys "{enter}"
End If
End Select
End Sub
Na formulář přidejte tlačítko cmdShowMsg:
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 Sub cmdShowMsg_Click()
'čas jsou 4 vteřiny (4000 mikrosekund)
SetTimer hWnd, NV_CLOSEMSGBOX, 4000, AddressOf TimerProc
If MsgBox("Tato zpráva se automaticky zavře po čtyřech vteřinách. _
Znovu nebo zrušit ?", vbRetryCancel + vbDefaultButton1, _
"Automatický MsgBox") = vbRetry Then
MsgBox "Znovu!"
Else
MsgBox "Zrušit"
End If
End Sub