'
'MODELE PATRICKTOULON
'======================================================
' !! TEMPORISER LE VRAI MSGBOX DE VBA !!
'catégorie boite de dialogue
'Temporisation du vrai msgbox de vba
'Auteurs:patricktoulon sur exceldownload
'Version :1.0; de patricktoulon
'Utilisation des api setTimer et KillTimer
'======================================================
'adaptation sur inputbox pour lever le bouton dans la caption
Option Explicit
#If VBA7 Then
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
Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
'Dim MsgBoxTitle
'Dim MsgBoxCloseD As Boolean
Public TimerID&
Public Sub ShootbuttonCloseOfInputbox()
Dim hwnd As Long
hwnd = GetActiveWindow
SetWindowLongA hwnd, -16, &H94C00080
If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
End Sub