Solution au bug SendKeys / Numlock

Version imprimable

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:

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:

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:

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.

08/02/2017, 19h12
Mat.M

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...
08/02/2017, 19h54
Marc-L

Bonjour !

Citation:

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, …
08/02/2017, 22h47
patricktoulon

RE

RE
BONSOIR

Code:

Application.SendKeys "%{DOWN}"

pourquoi ne pas faire un "activecell.offset(1,0).activate ou select???????????????
08/02/2017, 22h58
unparia

Bonjour patricktoulon

Citation:

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 ...

Bonjour et merci à tous pour vos réponses.

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

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 !

10/02/2017, 16h31
Marc-L

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

Salut, à tenter

Code:

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

Citation:
Envoyé par atk_49
Bonjour et merci à tous pour vos réponses.

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

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 :mouarf:
shell un point c'est tout
bien que je ne vois toujours pas l'utilité du sendkeys dans ce cas present

Code:

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

;)

09/01/2019, 09h36
atk_49

@kiki29

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

;)
09/01/2019, 09h44
patricktoulon

re

bonjour
a ben oui pour le coup tu a pris ton temps :mouarf:
12/11/2022, 22h10
GuillaumeG6916

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...)
12/11/2022, 22h23
deedolith

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.

Citation:

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:

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.