Solution au bug SendKeys / Numlock

**atk_49** · 08/02/2017, 18h51

Bonjour à tous.

Auriez-vous une solution fiable au bug (bien connu) de l'utilisation du sendkeys qui active ou désactive le Numlock ?

Je souhaite qu'une liste déroulante s'ouvre au premier clic et j'utilise le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
End If
End Sub

J'ai testé sans succès les solutions suivantes :

Doevents :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
Doevents
End If
End Sub

En fonction de l'état de la touche Numlock :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
If GetKeyState(vbKeyNumlock) = 1 Then
Application.SendKeys "{NUMLOCK}"
End If
End If
End Sub

Pouvez-vous m'aider ? L'ouverture en un clic du menu déroulant m'est vraiment très utile.

Merci et excellente fin de journée à tous.

**Mat.M** · 08/02/2017, 19h12

salut ,

1 éviter les "strings" à rallonge dans le code , cela l'obscurcit; dans l'instruction Range

2 pour répondre à la question , au pif essayer de voir si en faisant du subclassing.
Il faut essayer d'obtenir le handle de l'onglet avec l'API GetWindowLong et de gérer les instructions SendKeys.
Mais c'est une méthode peu orthodoxe...

**Marc-L** · 08/02/2017, 19h54

Bonjour !

Envoyé par atk_49

Auriez-vous une solution fiable au bug (bien connu) de l'utilisation du sendkeys qui active ou désactive le Numlock ?

Déjà ce n'est pas un bug, tout au plus une constatation, un désagrément …

La solution est simple : ne pas utiliser les SendKeys du VBA mais le SendKeys du Shell de Windows !
Parmi les nombreux exemples de ce forum voir cette discussion …

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**patricktoulon** · 08/02/2017, 22h47

RE
BONSOIR

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.SendKeys "%{DOWN}"

pourquoi ne pas faire un "activecell.offset(1,0).activate ou select???????????????

**unparia** · 08/02/2017, 22h58

Bonjour patricktoulon

pourquoi ne pas faire un "activecell.offset(1,0).activate ou select???????????????

pour au moins deux bonnes raisons :
- cela ne déploierait pas sa liste déroulante
- la nouvelle sélection résultante redéclencherait l'évènement selection_change, etc, etc ...

**atk_49** · 10/02/2017, 16h11

Bonjour et merci à tous pour vos réponses.

Voici le code définitif et qui fonctionne dans mon cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{down}"
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
Application.SendKeys ("{NUMLOCK}"), True
End If

Niveau Orthodoxie on reviendra, mais ça marche !

Bon week-end !

**Marc-L** · 10/02/2017, 16h31

Ou en une seule ligne de code via le Shell SendKeys comme pourtant indiqué en clair dans le code du lien ‼

**kiki29** · 15/01/2018, 13h37

Salut, à tenter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim Wsh As Object
 
    Set Wsh = CreateObject("WScript.Shell")
    Wsh .SendKeys "%{DOWN}", True
    Set Wsh = Nothing

**patricktoulon** · 15/01/2018, 13h46

Envoyé par atk_49

Bonjour et merci à tous pour vos réponses.

Voici le code définitif et qui fonctionne dans mon cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{down}"
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
Application.SendKeys ("{NUMLOCK}"), True
End If

Niveau Orthodoxie on reviendra, mais ça marche !

Bon week-end !

surtout que le soucis est aleatoire des fois ca coupe numlock des fois pas donc tes deux lignesnumlock ne font que repeter le problemesi numlock est en mode off tu le rallume et tu tu le re rebloque

shell un point c'est tout
bien que je ne vois toujours pas l'utilité du sendkeys dans ce cas present

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then target.offset(1,0).select

**atk_49** · 09/01/2019, 09h36

@kiki29

Merci avec un an de retard, en effet la méthode via le shell ne provoque plus le problème.

**patricktoulon** · 09/01/2019, 09h44

bonjour
a ben oui pour le coup tu a pris ton temps

**GuillaumeG6916** · 12/11/2022, 22h10

Bonjour,

J'ai essayé la méthode shell avec :
CreateObject("WScript.Shell").SendKeys "{F2}"

Mais j'ai toujours le problème qui désactive/réactive Numlock

Un grand merci pour votre aide (ça fait 5h que je cherche la réponse...)

**deedolith** · 12/11/2022, 22h23

Mouais, heu ....

D'une part évite le déterrage.
D'autre part, essayer de détourner les fonctionnalités standard, ce n'est jamais une bonne idée.

**laurent_ott** · 15/11/2022, 12h55

Envoyé par GuillaumeG6916

Mais j'ai toujours le problème qui désactive/réactive Numlock

bonjour,
c'est curieux que personne n'ait répondu car la solution est bien connue : il suffit d'utiliser les API.
Dans votre cas utilisez la fonction SetNumLock(False) pour désactiver le clavier numérique ou SetNumLock(True) pour l'activer.

Code VBA :

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
Option Explicit
 
' API Pour la gestion des touches du clavier:
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
 
' Constantes pour la gestion des touches du clavier:
Private Const VK_NUMLOCK = &H90
Private Const VK_CAPITAL = &H14
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
 
'------------------------------------------------------------------------------------------------
Private Sub SetKeyState(ByVal Key As Long, ByVal State As Boolean)
'------------------------------------------------------------------------------------------------
    keybd_event Key, MapVirtualKey(Key, 0), KEYEVENTF_EXTENDEDKEY Or 0, 0
    keybd_event Key, MapVirtualKey(Key, 0), KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
    If Key = 20 And State = False Then ' cas particulier pour VK_CAPITAL
        keybd_event 16, 0, 0, 0
        keybd_event 16, 0, 2, 0
    End If
End Sub
 
'------------------------------------------------------------------------------------------------
Public Sub SetNumLock(Etat As Boolean)
'------------------------------------------------------------------------------------------------
' Etat = True : Active le clavier numérirque.
' Etat = False : Désactive le clavier numérique.
'------------------------------------------------------------------------------------------------
While GetKeyState(VK_NUMLOCK) = 1 + Etat
    SetKeyState VK_NUMLOCK, Etat
    DoEvents
Wend
End Sub
 
'------------------------------------------------------------------------------------------------
Public Sub SetCapital(Etat As Boolean)
'------------------------------------------------------------------------------------------------
' Etat = True : Active le mode majuscule.
' Etat = False : Désactive le mode majuscule.
'------------------------------------------------------------------------------------------------
While GetKeyState(VK_CAPITAL) = 1 + Etat
    SetKeyState VK_CAPITAL, Etat
    DoEvents
Wend
End Sub
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------

Bonne programmations.

Solution au bug SendKeys / Numlock

Macros et VBA Excel

Discussions similaires

Partager

Partager