1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Option Explicit
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" ( _
ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function SetTimer& Lib "user32" ( _
ByVal Hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" ( _
ByVal Hwnd As Long, ByVal nIDEvent As Long)
Dim OnTimer&
Dim TitreInputBox$
'___________________________
Private Sub CloseInputBox()
Const WM_CLOSE = &H10
Dim Hwnd&
Hwnd& = FindWindow(vbNullString, TitreInputBox)
SendMessage Hwnd&, WM_CLOSE, 0, ByVal 0&
End Sub
'___________________________
Private Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseInputBox)
End Sub
'___________________________
Private Sub OffTimer()
If OnTimer& > 0 Then
OnTimer& = KillTimer(0&, OnTimer&)
OnTimer& = 0
End If
End Sub
'___________________________
Sub MonTraitement()
'--- traitement avant apparition de l'InputBox
'###
Dim retour
Dim Delai&
Delai = 5000 'délai de 5 secondes (à adapter)
TitreInputBox = "Veuillez saisir votre mot de passe"
RunTimer Delai
retour = Application.InputBox("On ferme dans " & Delai \ 1000 & " secondes", TitreInputBox)
OffTimer
'###
'--- suite
If retour = False Then Exit Sub
If retour <> "zaza" Then 'le bon mot de passe est zaza
MsgBox "Mot de passe incorrect"
Exit Sub
Else
MsgBox "Bon mot de passe"
End If
'--- suite
End Sub |
Partager