lancer action avec ctrl + entrée

Version imprimable

25/09/2024, 13h34
mosar3

lancer action avec ctrl + entrée
Bonjour,

je souhaite lancer une action avec ctrl + entrée dans un userform, sans que l'appui sur entrée ne fasse aller à la ligne si je suis encore dans un textbox (car actuellement un simple appui sur entrée fait un retour à la ligne).
Le code suivant ne se détecte pas le ctrl + entrée, il ne se passe rien : où est l'erreur svp ?
Code:

1 2 3 4 5 Private Sub UserformBilan_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If Chr(KeyAscii) = "^{ENTER}" Then Call BoutonValider_Click End If End Sub
merci!

1 pièce(s) jointe(s)

Jette un coup d’œil sur le code suivant ..
code de module

Code:

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
Option Explicit
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 
Private Const WH_KEYBOARD = 2
Private Const VK_LCONTROL = 162 ' Ctrl gauche
 
Private fHook As LongPtr
 
Private Function KeyboardProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
  KeyboardProc = 0
  If (nCode = 0) And ((lParam And &HC0000000) = 0) Then
  On Error Resume Next
    If wParam = 13 Then ' touche entrée
       If GetKeyState(VK_LCONTROL) < 0 Then ' controle gauche appuyé
           KeyboardProc = 1 ' intercepter la touche
 
 
           MsgBox "Ctrl + entrée intercepté"
 
       End If
    End If
  End If
If (nCode < 0) Or (KeyboardProc = 0) Then: KeyboardProc = CallNextHookEx(fHook, nCode, wParam, lParam)
End Function
 
Public Sub EndHook()
  If fHook <> 0 Then
     UnhookWindowsHookEx fHook
     fHook = 0
  End If
End Sub
 
Public Sub StartHook()
  EndHook
  fHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, GetCurrentThreadId)
End Sub

27/09/2024, 09h38
mosar3

Bonjour,

Merci de la proposition avec un code assez complexe que je ne comprends pas bien. Force est de constater qu'il fonctionne bien sur le fichier que tu partages, mais sur mon projet qui est très long et que je ne peux envoyer, il fait buguer visual basic editor !
C'est assez incompréhensible, l'ordi semble ramer et se bloquer dès que je déverrouille le mdp de mon projet sur vbe, je dois le couper avec le gestionnaire des taches. Puis en revenant dessus dès que je lancer le moindre clic sur vbe rebug ! Et en supprimant le module idem. Puis en supprimant les quelques lignes sur le usf ça redevient normal.

Alors que ce n'est pas le cas sur ton fichier. Ca me fait un peu penser au bug du débugueur vbe avec le mouse scroll de Cristian Buse...
Je n'ai pas d'explication et ne sais que conclure...8O
D'autant que ce n'est pas intermittent, c'est systématique il y a vraiment quelque chose qui coince, j'imagine une incompatibilité un peu étonnante avec autre chose dans mon code.
27/09/2024, 11h09
jurassic pork

Hello mosar3,
tu utilises quelle version d'Excel sous quel O.S ?
Si tu crée un classeur avec le formulaire qui utilise le code de gestion du clavier as-tu le problème ?

[EDIT] j'avais écrit dans un autre forum où il y avait aussi un problème avec plantage d'Excel :

Citation:

avec l'emploi d'un adressof si la procédure est exécutée au mauvais moment, ça peut faire planter Excel

Ami calmant, J.P

Bonjour
a partir du moment ou le userform a au minimum un control activX le userform je peut plus gérer le keycode ar il n'a plus jamais le focus a lui tout seul car quand le userform prend le focus c'est son controls(1) qui prend le focus

cela dit on peut tricher
il te suffit de mettre un textbox de taille 0 ou caché(Attention pas invisible)
tu peux le mettre a un left plus grand que la taille du userform par exemple

et dans l'event mousedown du userform tu donne le focus a ce textbox
et dans l'events keydown de ce testbox
si shift=2 and keycode= tilde alors tu apelle ta procedure
Code:

1 2 3 4 5 6 7 Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If Shift = 2 And KeyCode = 13 Then procedure End Sub Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) TextBox1.SetFocus End Sub

27/09/2024, 14h06
Invité
Citation:

C'est assez incompréhensible, l'ordi semble ramer et se bloquer dès que je déverrouille le mdp de mon projet sur vbe, je dois le couper avec le gestionnaire des taches. Puis en revenant dessus dès que je lancer le moindre clic sur vbe rebug ! Et en supprimant le module idem. Puis en supprimant les quelques lignes sur le usf ça redevient normal.

Le code fonctionne si la forme est lancée en Showmodal.. travailler en mode non modal est trop risqué car le projet peut à tout moment être stoppé ou recompilé sans désinstaller le hook, l'utilisation de WH_KEYBOARD au lieu de WH_KEYBOARD_LL permet l’installation du hook uniquement sur le processus en cours, WH_KEYBOARD_LL ne bloque pas mais intercepte toutes frappes mêmes celles d'autres applications, ce qui n'a pas de sens ...
Citation:
Code:

1 2 3 Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If Shift = 2 And KeyCode = 13 Then procedure End Sub
Il manque l'interception du caractère pour empêcher la propagation dans le gestionnaire d’événement KeyDown
Code:

1 2 3 4 If Shift = 2 And KeyCode = 13 Then KeyCode.Value = 0 .. End If
27/09/2024, 22h30
mosar3

Bonjour à tous,

@Jurassic Pork c'est office 2024 sous windows 11. Et pas sûr de comprendre ta question, si je crée un classeur avec le juste le code de rmist2024 est ce que ça plante ? La réponse est non ça ne plante pas. Et en rajoutant des contrôles de toutes sortes ça ne plante pas non plus.

@patmeziere je ne comprends pas : ton premier sub dit que si on est sur textbox1 et qu'on appui sur une touche on lance le if et donc la procédure, et le second sub met le focus sur textbox 1 quand on clique sur le userform? Du coup si je clique sur textbox 2 par exemple, le focus est sur textbox2 et non textbox1 et donc le sub 1 ne se lance pas si on appui sur une touche... Mais en testant quand même je constate que si : le sub 1 se lance quand même même si j'écris sur textbox2... pourquoi !? Par ailleurs j'ai cru que c'était bon du coup, et en revenant sur vbe... planton! Donc je quitte vbe depuis le gestionnaire des taches, et impossible de faire quoi que ce soit sur vbe par la suite ça plante dès que je change une virgule au code sur vbe...
C'est le cas aussi avec KeyCode.Value = 0

@rmist2024 je ne comprends pas l'histoire des WH_KEYBOARD_LL :lol:
28/09/2024, 06h22
patmeziere

re

bonjour
je te cite

Citation:

je souhaite lancer une action avec ctrl + entrée dans un userform,

si tu est dans un textbox tu n'est plus dans le userform directement

si tu veux que tes touche ctrl+Enter agissent ou que tu soit dans le userform
il va te falloir classer tout des control ayant a dispos l'event keydown

pour info l'event keypress ne gere pas les touche système comme ( conntrol tab maj supp back etc....)
c'est pour ça que ton code keypress ne peut fonctionner

ne pas confondre les events keypress et keydown
keypress renvoi le code asc du caractère de la touche
keydown renvoie le code de la touche

re
j'ai testé le hook du keybord de rMist2024
et ça semble répondre a ton besoin

cela dit je ferais une gestion d'erreur plus precise car le adressof a ses avantage et inconvénients
en effet en addressof on a pas de sauve conduit si une erreur se déclenche elle va en déclencher en cascade au bout d'un moment on atteint le out memory et le crash excel

Code:

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
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 
Private Const WH_KEYBOARD = 2
Private Const VK_LCONTROL = 162 ' Ctrl gauche
 
Private fHook As LongPtr
 
Private Function KeyboardProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    KeyboardProc = 0
    If (nCode = 0) And ((lParam And &HC0000000) = 0) Then
        On Error GoTo gestionerreur
        If wParam = 13 Then ' touche entrée
            If GetKeyState(VK_LCONTROL) < 0 Then ' controle gauche appuyé
                KeyboardProc = 1 ' intercepter la touche
                procedureCTRL_Enter
            End If
        End If
    End If
    If (nCode < 0) Or (KeyboardProc = 0) Then: KeyboardProc = CallNextHookEx(fHook, nCode, wParam, lParam)
    Exit Function
gestionerreur:
    EndHook 'en cas d'erreur grave on arrete le hook
    StartHook ' et on le redemarre
 
End Function
 
Public Sub EndHook()
    If fHook <> 0 Then
        UnhookWindowsHookEx fHook
        fHook = 0
    End If
End Sub
 
Public Sub StartHook()
    EndHook
    fHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, GetCurrentThreadId)
End Sub
 
Sub procedureCTRL_Enter()
    MsgBox "Ctrl + entrée intercepté"
 
End Sub

2 pièce(s) jointe(s)

Hello,

Citation:

Envoyé par patmeziere

Bonjour
a partir du moment ou le userform a au minimum un control activX le userform je peut plus gérer le keycode ar il n'a plus jamais le focus a lui tout seul car quand le userform prend le focus c'est son controls(1) qui prend le focus

Ce n'est pas tout à fait vrai car si les contrôles ont la propriété TabStop à False, le Userform a le focus tant qu'on a pas mis le focus sur un contrôle (par exemple en entrant du texte dans un TextBox)
On peut très bien intercepter le ctrl Entrée si dans les KeyDown des contrôles qui possèdent un événement KeyDown (dont le formulaire) on appelle une sous-routine qui teste le ctrl+entrée
Exemple avec un formulaire qui possède deux textbox et un bouton de commande :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub TextBox1_KeyDown(ByVal Keycode As MSForms.ReturnInteger, ByVal Shift As Integer) CtrlEnter Keycode, Shift End Sub Private Sub TextBox2_KeyDown(ByVal Keycode As MSForms.ReturnInteger, ByVal Shift As Integer) CtrlEnter Keycode, Shift End Sub Private Sub UserForm_KeyDown(ByVal Keycode As MSForms.ReturnInteger, ByVal Shift As Integer) CtrlEnter Keycode, Shift End Sub Sub CtrlEnter(Keycode, Shift) If Shift = 2 And Keycode = 13 Then MsgBox "CTRL + Entrée" Keycode.Value = 0 End If End Sub Private Sub CommandButton1_Click() MsgBox "CommandButton1 cliqué" End Sub
Pièce jointe 659854

Classeur en pièce jointe.

Ami calmant, J.P

28/09/2024, 08h38
patmeziere

re

Bonjour jurassic Pork
si tu a 50 textbox ça va être drôle

pourquoi j'ai proposé ma méthode du control caché?:
et bien tout simplement pour ne pas réinventer la roue
un menu contextuel affiché il faut sélectionner une autre cellule pour le fermer si on sélectionne pas dans le menu
une combobox pareil idem même punition il faut sélectionner ailleurs
et c'est quasiment partout pareil dans windows

donc en donnant le focus a un seul textbox caché au click dans le userform on a un comportement identique a l'original

sinon il faut classer les controls pour ne faire qu'un seul event
et encore la si des controls n'ont pas le keydown ben t' mort pour peu que ce soit l'un d'eux qui ai le focus

conclusion:
pour les débutants ne connaissant rien aux api ma méthode est raisonnablement adéquate
pour les plus à guéris la proposition de rMist2024 fait parfaitement le boulot en poussant un peu plus la gestion d'erreur comme je l'ai suggéré dans un post précédent
Voila;)
28/09/2024, 08h57
jurassic pork

mosar3 a de quoi résoudre son problème maintenant ;)
28/09/2024, 12h54
mosar3

Bonjour à tous, désolé mais je ne vois pas la solution au plantage de vbe ? Sur le dernier code de @patmeziere, si je le mets dans le fichier initial de rmist2024 dans le module CHookModule, il ne se passe rien sur ctrl + entrée..
28/09/2024, 14h32
patmeziere

1 pièce(s) jointe(s)

re

re
fichier en exemple
Pièce jointe 659872 Pièce jointe 659872
28/09/2024, 14h55
78chris

Bonjour à tous

Citation:

Envoyé par mosar3

Bonjour à tous, désolé mais je ne vois pas la solution au plantage de vbe ? Sur le dernier code de @patmeziere, si je le mets dans le fichier initial de rmist2024 dans le module CHookModule, il ne se passe rien sur ctrl + entrée..

CTRL Entrée étant un raccourci de base dans Ecel (je l'utilise à longueur de temps comme beaucoup d'autres) je trouve curieux de le réattribuer à une macro perso...

1 pièce(s) jointe(s)

Bonjour à tous,

Ci-joint un autre exemple qui montre comment intercepter le <Ctrl> + <Entrée> tapé depuis un formulaire ou un de ses contrôles.
Il se base sur la classe Cls_FrmEvents dont le but est de "centraliser et renvoyer" les évènements (ici KeyDown) d'un formulaire et de ses contrôles.

Code du formulaire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Private WithEvents oKeyPress As Cls_FrmEvents
 
Private Sub UserForm_Initialize()
    Set oKeyPress = New Cls_FrmEvents
    oKeyPress.InitUserformControls Me
End Sub
 
Private Sub oKeyPress_KeyDownFromObject(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ObjectSource As Object)
    If Shift = 2 And KeyCode = 13 Then
        MsgBox "<Ctrl> + <Entrée>", vbInformation, "Info"
    End If
End Sub

Code de la classe Cls_FrmEvents :

Code:

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
 
Public Event KeyDownFromObject(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ObjectSource As Object)
 
Private WithEvents objCheckBox As MSForms.CheckBox
Private WithEvents objComboBox As MSForms.ComboBox
Private WithEvents objCommandButton As MSForms.CommandButton
Private WithEvents objFrame As MSForms.Frame
Private WithEvents objListBox As MSForms.ListBox
Private WithEvents objMultiPage As MSForms.MultiPage
Private WithEvents objOptionButton As MSForms.OptionButton
Private WithEvents objScrollBar As MSForms.ScrollBar
Private WithEvents objSpinButton As MSForms.SpinButton
Private WithEvents objTabStrip As MSForms.TabStrip
Private WithEvents objTextBox As MSForms.TextBox
Private WithEvents objToggleButton As MSForms.ToggleButton
Private WithEvents objUserForm As MSForms.UserForm
 
Private collControls As VBA.Collection
 
Private oParent As Cls_FrmEvents
 
Public Sub SendKeyDownEvent(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, fromObject As Object)
    RaiseEvent KeyDownFromObject(KeyCode, Shift, fromObject)
End Sub
 
Private Sub objCheckBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):        oParent.SendKeyDownEvent KeyCode, Shift, objCheckBox:       End Sub
Private Sub objComboBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):        oParent.SendKeyDownEvent KeyCode, Shift, objComboBox:       End Sub
Private Sub objCommandButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):   oParent.SendKeyDownEvent KeyCode, Shift, objCommandButton:  End Sub
Private Sub objFrame_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):           oParent.SendKeyDownEvent KeyCode, Shift, objFrame:          End Sub
Private Sub objListBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):         oParent.SendKeyDownEvent KeyCode, Shift, objListBox:        End Sub
Private Sub objMultiPage_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):       oParent.SendKeyDownEvent KeyCode, Shift, objMultiPage:      End Sub
Private Sub objOptionButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):    oParent.SendKeyDownEvent KeyCode, Shift, objOptionButton:   End Sub
Private Sub objScrollBar_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):       oParent.SendKeyDownEvent KeyCode, Shift, objScrollBar:      End Sub
Private Sub objSpinButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):      oParent.SendKeyDownEvent KeyCode, Shift, objSpinButton:     End Sub
Private Sub objTabStrip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):        oParent.SendKeyDownEvent KeyCode, Shift, objTabStrip:       End Sub
Private Sub objTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):         oParent.SendKeyDownEvent KeyCode, Shift, objTextBox:        End Sub
Private Sub objToggleButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):    oParent.SendKeyDownEvent KeyCode, Shift, objToggleButton:   End Sub
Private Sub objUserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer):        oParent.SendKeyDownEvent KeyCode, Shift, objUserForm:       End Sub
 
Public Sub InitUserformControls(frm As MSForms.UserForm)
Dim ctrl As MSForms.Control
Dim oCtrl As Cls_FrmEvents
    Set collControls = New VBA.Collection
    Set oCtrl = New Cls_FrmEvents
    If oCtrl.SetCtrl(frm, Me) Then collControls.Add oCtrl
    For Each ctrl In frm.Controls
        Set oCtrl = New Cls_FrmEvents
        If oCtrl.SetCtrl(ctrl, Me) Then collControls.Add oCtrl
    Next ctrl
End Sub
 
Public Function SetCtrl(ctrl As Object, p As Cls_FrmEvents) As Boolean
    SetCtrl = True
    Set oParent = p
    Select Case TypeName(ctrl)
        Case "CheckBox":        Set objCheckBox = ctrl
        Case "ComboBox":        Set objComboBox = ctrl
        Case "CommandButton":   Set objCommandButton = ctrl
        Case "Frame":           Set objFrame = ctrl
        Case "ListBox":         Set objListBox = ctrl
        Case "MultiPage":       Set objMultiPage = ctrl
        Case "OptionButton":    Set objOptionButton = ctrl
        Case "ScrollBar":       Set objScrollBar = ctrl
        Case "SpinButton":      Set objSpinButton = ctrl
        Case "TabStrip":        Set objTabStrip = ctrl
        Case "TextBox":         Set objTextBox = ctrl
        Case "ToggleButton":    Set objToggleButton = ctrl
        Case Else
            If TypeOf ctrl Is UserForm Then
                Set objUserForm = ctrl
            Else
                SetCtrl = False
            End If
    End Select
End Function

A+

Citation:

je ne comprends pas l'histoire des WH_KEYBOARD_L

Oublie les hook Excel n'est pas le bon endroit pour les hooks qui tournent tout au long de l’exécution du code ça risque de bloquer ou faire crasher l'application, Excel peut décharger le module référencé par la fonction du hook et au prochain appel il sera dirigé vers une adresse de code invalide.

Il y a une autre alternative via l'API windows RegisterHotKey qui permet la création d'un raccourci personnalisé et une fois détecté un message sera envoyé à l'application pour le notifier, il suffit de l'intercepter pour déclencher votre code ..

regarder cet exemple

Code:

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
'source
'https://www.mrexcel.com/board/threads/keyboard-hook-to-be-used-as-shortcut-to-fire-up-macro-outside-excel.996633/#post-4783225
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
#If VBA7 Then
    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
 
    Private Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Private Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
#Else
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
 
    Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
#End If
 
Private Const MOD_CONTROL = &H2
 
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
 
Private bCancel As Boolean
 
Private Sub UserForm_Activate()
    bCancel = False
    Call RegisterHotKey(Application.hwnd, &HBFFF&, MOD_CONTROL, 13)
 
    Call Key_Listener
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    bCancel = True
End Sub
 
Private Sub Key_Listener()
    Dim message As MSG
 
    On Error GoTo Oops
 
    Do While Not bCancel
        WaitMessage
            If PeekMessage(message, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
                'Comment out this line if you don't wish to activate excel.[/COLOR]
                VBA.AppActivate Application.Caption
                'Execute the 'Test' procedure.[/COLOR]
                Call Test
            End If
        DoEvents
    Loop
 
Oops:
    Call UnregisterHotKey(Application.hwnd, &HBFFF&)
End Sub
 
 
Private Sub Test()
    MsgBox "Procedure invoked !", vbApplicationModal
End Sub

28/09/2024, 20h45
Invité

@patmeziere
@jurassic pork

Il me semble que la déclaration de la fonction CallNextHookEx n'est pas correcte pour le paramètre lParam passé par référence alors que ce dernier n'est pas une structure pour le hook WH_KEYBOARD mais juste une valeur entière portant des infos supplémentaire sur la touche appuyée..

Code:

Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
28/09/2024, 22h25
mosar3

Merci à tous pour vos contributions, le code de mromain marche parfaitement pour moi !

Bonjour rMIST2024
c'est pas mal du tout
reste que là on a une sub qui est exécutée au moindre mouvement de souris ou touche tapé et qui fait 5 à 10 tours de boucle à chaque fois et cela dans le même tread du userform

Code:

Dim i as long 'en haut de module

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Key_Listener()
    Dim message As MSG
 
    On Error GoTo Oops
 
    Do While Not bCancel
        WaitMessage
 
        If PeekMessage(message, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            'Comment out this line if you don't wish to activate excel.[/COLOR]
            VBA.AppActivate Application.Caption
            'Execute the 'Test' procedure.[/COLOR]
            Call Test
        End If
        DoEvents
        i = i + 1
        Me.Caption = "lancements du listener" & i
    Loop
Oops:
    Call UnregisterHotKey(Application.hwnd, &HBFFF&)
End Sub

---------------------------------------------------------------------------------------------------------------
tandis qu'en addressOf ca passe en dehors du tread
bien sur la gestion d'erreur doit être un peu plus costaud
dans la caption du userform j'affiche le nombre de passe d'arrêts et de re lancement
on voit bien qu'en adressof c'est beaucoup plus rapide
par contre il n'y a pas de re lancement si tu fait rien a l'inverse de la méthode registerkey avec un listener en boucle et qui se relance dès que tu bouje la souris n'importe ou

Code:

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
Option Explicit
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 
Private Const WH_KEYBOARD = 2
Private Const VK_LCONTROL = 162 ' Ctrl gauche
 
Private fHook As LongPtr
Public i As Long
Public Re As Long
Public fin As Long
 
Private Function KeyboardProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    KeyboardProc = 0
    If (nCode = 0) And ((lParam And &HC0000000) = 0) Then
        On Error GoTo gestionErreur
        If wParam = 13 Then ' touche entrée
            If GetKeyState(VK_LCONTROL) < 0 Then ' controle gauche appuyé
                KeyboardProc = 1 ' intercepter la touche
                Call procedure
                i = i + 1
                UserForm1.Caption = "de Tours en AdressOF " & i & " NB relances : " & Re & "/ NB arrêts : " & fin
 
            End If
        End If
    End If
 
    If (nCode < 0) Or (KeyboardProc = 0) Then EndHook: StartHook 'KeyboardProc = CallNextHookEx(fHook, nCode, wParam, lParam)
        EndHook
        StartHook
        Exit Function
gestionErreur:
EndHook:         MsgBox "houla ca deraille !!!"
    End Function
 
Public Sub EndHook()
    If fHook <> 0 Then
        fin = fin + 1
        UnhookWindowsHookEx fHook
        fHook = 0
    End If
End Sub
 
Public Sub StartHook()
    Re = Re + 1
    EndHook
    fHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, GetCurrentThreadId)
End Sub
 
Public Sub procedure()
    MsgBox " Touches Ctrl + Enter activées "
End Sub