IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

lancer action avec ctrl + entrée


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    Profil pro
    Inscrit en
    Novembre 2009
    Messages
    90
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Novembre 2009
    Messages : 90
    Points : 46
    Points
    46
    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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!

  2. #2
    Membre régulier
    Homme Profil pro
    libre
    Inscrit en
    Septembre 2024
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : libre

    Informations forums :
    Inscription : Septembre 2024
    Messages : 65
    Points : 116
    Points
    116
    Par défaut
    Jette un coup d’œil sur le code suivant ..
    code de module
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Fichiers attachés Fichiers attachés

  3. #3
    Membre du Club
    Profil pro
    Inscrit en
    Novembre 2009
    Messages
    90
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Novembre 2009
    Messages : 90
    Points : 46
    Points
    46
    Par défaut
    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...
    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.

  4. #4
    Expert éminent
    Avatar de jurassic pork
    Homme Profil pro
    Bidouilleur
    Inscrit en
    Décembre 2008
    Messages
    4 100
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Bidouilleur
    Secteur : Industrie

    Informations forums :
    Inscription : Décembre 2008
    Messages : 4 100
    Points : 9 590
    Points
    9 590
    Par défaut
    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 :
    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
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  5. #5
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut re
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  6. #6
    Membre régulier
    Homme Profil pro
    libre
    Inscrit en
    Septembre 2024
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : libre

    Informations forums :
    Inscription : Septembre 2024
    Messages : 65
    Points : 116
    Points
    116
    Par défaut
    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 ...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
      If Shift = 2 And KeyCode = 13 Then
         KeyCode.Value = 0
         ..
      End If

  7. #7
    Membre du Club
    Profil pro
    Inscrit en
    Novembre 2009
    Messages
    90
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Novembre 2009
    Messages : 90
    Points : 46
    Points
    46
    Par défaut
    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

  8. #8
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut re
    bonjour
    je te cite
    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

  9. #9
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut re
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  10. #10
    Expert éminent
    Avatar de jurassic pork
    Homme Profil pro
    Bidouilleur
    Inscrit en
    Décembre 2008
    Messages
    4 100
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Bidouilleur
    Secteur : Industrie

    Informations forums :
    Inscription : Décembre 2008
    Messages : 4 100
    Points : 9 590
    Points
    9 590
    Par défaut
    Hello,
    Citation Envoyé par patmeziere Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Nom : ShortcutInterceptJP.gif
Affichages : 112
Taille : 211,4 Ko


    Classeur en pièce jointe.

    Ami calmant, J.P
    Fichiers attachés Fichiers attachés
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  11. #11
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut 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

  12. #12
    Expert éminent
    Avatar de jurassic pork
    Homme Profil pro
    Bidouilleur
    Inscrit en
    Décembre 2008
    Messages
    4 100
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Bidouilleur
    Secteur : Industrie

    Informations forums :
    Inscription : Décembre 2008
    Messages : 4 100
    Points : 9 590
    Points
    9 590
    Par défaut
    mosar3 a de quoi résoudre son problème maintenant
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  13. #13
    Membre du Club
    Profil pro
    Inscrit en
    Novembre 2009
    Messages
    90
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Novembre 2009
    Messages : 90
    Points : 46
    Points
    46
    Par défaut
    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..

  14. #14
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut re
    re
    fichier en exemple
    Shortcut Hook.xlsmShortcut Hook.xlsm

  15. #15
    Expert éminent sénior

    Profil pro
    Conseil, Formation, Développement - Indépendant
    Inscrit en
    Février 2010
    Messages
    8 526
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations professionnelles :
    Activité : Conseil, Formation, Développement - Indépendant

    Informations forums :
    Inscription : Février 2010
    Messages : 8 526
    Points : 16 463
    Points
    16 463
    Par défaut
    Bonjour à tous
    Citation Envoyé par mosar3 Voir le message
    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...
    Chris
    PowerQuery existe depuis plus de 13 ans, est totalement intégré à Excel 2016 &+. Utilisez-le !

    Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
    Confucius

    ----------------------------------------------------------------------------------------------
    En cas de résolution, n'hésitez pas cliquer sur c'est toujours apprécié...

  16. #16
    Membre confirmé
    Inscrit en
    Avril 2008
    Messages
    247
    Détails du profil
    Informations personnelles :
    Localisation : Autre

    Informations forums :
    Inscription : Avril 2008
    Messages : 247
    Points : 497
    Points
    497
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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+
    Fichiers attachés Fichiers attachés

  17. #17
    Membre régulier
    Homme Profil pro
    libre
    Inscrit en
    Septembre 2024
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : libre

    Informations forums :
    Inscription : Septembre 2024
    Messages : 65
    Points : 116
    Points
    116
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  18. #18
    Membre régulier
    Homme Profil pro
    libre
    Inscrit en
    Septembre 2024
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : libre

    Informations forums :
    Inscription : Septembre 2024
    Messages : 65
    Points : 116
    Points
    116
    Par défaut
    @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 : Sélectionner tout - Visualiser dans une fenêtre à part
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr

  19. #19
    Membre du Club
    Profil pro
    Inscrit en
    Novembre 2009
    Messages
    90
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Novembre 2009
    Messages : 90
    Points : 46
    Points
    46
    Par défaut
    Merci à tous pour vos contributions, le code de mromain marche parfaitement pour moi !

  20. #20
    Membre actif
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 162
    Points : 280
    Points
    280
    Par défaut re
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim i as long 'en haut de module
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 1
    Dernier message: 21/11/2019, 21h37
  2. Ouvrir un pdf et lancer une action avec acrobat pro X
    Par acbdev dans le forum VBScript
    Réponses: 5
    Dernier message: 20/12/2014, 10h14
  3. Lancer appli avec un utilisateur particulier
    Par [DreaMs] dans le forum Langage
    Réponses: 6
    Dernier message: 14/09/2005, 10h20
  4. Réponses: 4
    Dernier message: 27/04/2004, 15h45
  5. [VB6] Multiselection avec CTRL dans une msflexgrid
    Par Troopers dans le forum VB 6 et antérieur
    Réponses: 6
    Dernier message: 17/04/2003, 11h57

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo