'event feuille
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If TimerID = 0 Then TimerID = SetTimer(0, 0, 50, AddressOf ShootbuttonCloseOfInputbox)
Dim V$, nom$
V = CStr(Target.value)
If Not Intersect(Target, Range("a1:zz10000")) Is Nothing Then
nom = InputBox("Saisir ou modifier", "", V)
If StrPtr(nom) > 0 Then Target.value = nom
End If
End Sub
'dans un module standard
'
'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 Win64 Then
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare Function KillTimer Lib "user32" (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
