Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal Hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal Hwnd As LongPtr, ByVal nIDEvent As Long) As Long
Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal Hwnd As LongPtr) As Long
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal Hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal Hwnd As LongPtr, ByVal nIDEvent As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal Hwnd As Long) As Long
#End If
Private Const WM_CLOSE As Integer = &H10
Dim capt$
Dim byebye As Boolean
Dim timerID&
Function msgboxX(message, style, titre, Optional helper, Optional contexte, Optional NbSecondes As Long = 3)
Dim X
timerID = SetTimer(0, 0, NbSecondes * 1000, AddressOf fermeMessage)
byebye = False: capt = titre
X = msgboX(message, style, titre)
If byebye Then
msgboxX = "timeOut!!"
Else
If timerID Then KillTimer 0, timerID
msgboxX = X
End If
End Function
Public Sub fermeMessage()
Dim Hwnd&
If timerID <> 0 Then KillTimer 0, timerID
timerID = 0: byebye = True
Hwnd = FindWindow(vbNullString, capt)
SetFocus Hwnd
CreateObject("wscript.shell").SendKeys ("{right}{Enter}") 'choisi "No" automatiquement
End Sub
Sub test()
Dim rep
rep = msgboxX("salut les loulous", vbYesNo, "testmessage", , , 3)
msgboX rep
End Sub