XL 2019 Perte du NumLock

[fanch55]

Bonsoir à Tous,

Cela fait des années que je recherche à résoudre la perte du "NumLock" ou "VerrNum" sur le Clavier.

Quand je clique sur une cellule qui a une Validation de Données type Liste,
j'envoie un SendKeys "%{down}%", True sans attendre que l'utilisateur clique sur la flèche de dropdown.
Systématiquement, cela provoque la désactivation du NumLock .

J'ai essayé les api getkeyboardstate et autres getkeystate et tenter d'appliquer des
SendKeys "{NUMLOCK}" avec true ou pas, cela ne fonctionne jamais correctement .

Si quelqu'un a une astuce infaillible et non aléatoire pour rétablir le numlock, je suis preneur ...

 

[job75]

Bonsoir fanch55;

Je suis étonné que vous découvriez seulement maintenant cet effet de Application.SendKeys.

Qui date de Excel 2007 ou 2010.

Le problème se règle en utilisant CreateObject("WScript.Shell").SendKeys.

Faites une recherche sur mes posts avec le mot clé SendKeys, il y en a un paquet.

A+

 

[fanch55]

Bonsoir @job75,
Ce n'est pas faute de chercher, mais c'est faute de mal appliquer.

En fait je me suis focalisé sur le NumLock
et le fait d'utiliser CreateObject("WScript.Shell").SendKeys "{NUMLOCK}" ne résout rien.

Il faut effectivement prendre le pb à la base et
faire un CreateObject("WScript.Shell").SendKeys "%{down}%"
Ceci n'impacte pas le NumLock effectivement .

Merci beaucoup pour cette astuce .

 

[Dudu2]

Bonjour les Experts,

Le Sendkeys "abc", True permet d'attendre la fin de l'envoi des touches avant de rendre le contrôle à la macro.

Avec un CreateObject("WScript.Shell").SendKeys, il me semble que l'on créé un processus indépendant qui va envoyer de manière asynchrone les touches. Me trompai-je ?

Si c'est bien le cas, il faut faire attention à ce que le traitement ne présuppose pas que ces touches aient été effectivement envoyées après l'instruction du SendKeys.

Dans cet exemple [B1].Value vaudra "aaa" et non "bbb".

Sub a()
    [A1].Value = "aaa"
    [A1].Select
    CreateObject("wscript.shell").SendKeys "bbb{ENTER}"
    [B1].Value = [A1].Value
End Sub

Alors que dans cet exemple [B1].Value vaudra bien "bbb".

Sub a()
    [A1].Value = "aaa"
    [A1].Select
    SendKeys "bbb{ENTER}", True
    [B1].Value = [A1].Value
End Sub

J'aimerais bien trouver un moyen de le rendre synchrone avec un WaitForSingleObject sur le Handle du processus lancé mais pour l'instant je n'ai aucune idée de comment faire pour récupérer un Handle utile.

 

[patricktoulon]

re
des fois wscript.shell déraille aussi avec le sendkeys je l'ai remarqué depuis quelques mois sur mon notebook
mais dans la majorité des PCs il fonctionne

sinon tu a les apis et en macro4 et là jamais de soucis puisque les touche sont bien relachées qui est le probleme de sendkeys que ce soit pour wscript.shell ou application

donc
on appui sur CTRL on la garde et on appui sur la flèche bas et on relâche les touches

Function Xsendkeys(key, sens)
ExecuteExcel4Macro ("CALL(""user32"",""keybd_event"",""JJJJJ""," & key & ", " & 1 & ", " & sens & ", " & 0 & ")")     'api SetWindowLongA
End Function

Sub test()
Xsendkeys 17, 0 'on apui sur la touche CTRL
Xsendkeys 40, 0 ' on apui sur la touche bas
Xsendkeys 40, &H2 'on relache la touche bas
Xsendkeys 17, &H2 'on relache la touche CTRL
End Sub

et voila on est en bas de page

' Pour d'autres touches...
' a à z 65 à 90
' Home 36
' End 35
' Flêche vers le haut 38
' Flêche vers le bas 40
' Flêche vers la gauche 37
' Flêche vers la droite 39
' Echap 27
' Impr écran 44 (= vbKeySnapshot)
' Page haut 33
' Page bas 34
' Insert 45
' F1 à F12 112 à 123
' Barre d'espace 32
' Ctrl 17
' Alt 18
' Maj 16
' Verr Num 144
' Arrêt défil 145
' Tab 9
' Shift 16

 

[Dudu2]

Pour un SendKeys Wait, il faut en passer par là:

#If VBA7 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Sub SendKeysWait(Keys As String)
    Dim NumLock As Boolean
 
    NumLock = IsNumLock
    SendKeys Keys, True
    If NumLock <> IsNumLock Then SendKeys "{NUMLOCK}", True
End Sub

Private Function IsNumLock() As Boolean
    Const VK_NUMLOCK = &H90 ' ou 144

    If GetKeyState(VK_NUMLOCK) Then IsNumLock = True
End Function

@patricktoulon doit bien avoir un ExecuteMacro4Excel pour le GetKeyState.

 

[Dudu2]

Bon j'ai transformé:

GetKeyState(VK_NUMLOCK)

En

ExecuteExcel4Macro("CALL(""user32"", ""GetKeyState"", ""JJ"", 144)")

Mais le comportement du SendKeys s'en trouve affecté. Il faut donc rester sur l'API pour le GetKeyState(VK_NUMLOCK).

Edit: A noter que le Application.SendKeys ne fait pas la même chose qu'un SendKeys.
A moins que je me trompe sur la définition du Wait, Application.SendKeys "bbb{ENTER}", True ne fait pas de Wait contrairement à ce que dit la documentation ! Et se comporte comme un CreateObject("wscript.shell").SendKeys "bbb{ENTER}".
De plus (chez moi) l'impact sur la touche NUMLOCK est différent.

En fait le SendKeys, c'est tout sauf simple.

 

[fanch55]

Pour un SendKeys Wait, il faut en passer par là:

#If VBA7 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Sub SendKeysWait(Keys As String)
    Dim NumLock As Boolean
 
    NumLock = IsNumLock
    SendKeys Keys, True
    If NumLock <> IsNumLock Then SendKeys "{NUMLOCK}", True
End Sub

Private Function IsNumLock() As Boolean
    Const VK_NUMLOCK = &H90 ' ou 144

    If GetKeyState(VK_NUMLOCK) Then IsNumLock = True
End Function

@patricktoulon doit bien avoir un ExecuteMacro4Excel pour le GetKeyState.

Salut à tous,
@Dudu2,
C'est tout à fait ce que j'avais fait en premier abord, mais mon NumLock n'était jamais strictement remis en service et le GetKeystate m'affirmait le contraire ou pas .....
J'ai même essayé une boucle pour faire un sendkey Numlock jusqu'à ce que le Getkeystate m'indique bien qu'il était remis --> à ne pas faire, boucle infernale à tuer uniquement par le gestionnaire des taches ..

@patricktoulon ,
Ta méthode quoique plus longue en lignes de code fonctionne parfaitement.
Par contre, je ne suis plus notifié quand tu réagis aux post auxquels je participe ou crée !?

 

[Dudu2]

Bonjour @fanch55,
En effet tu as raison, rien ne fonctionne comme prévu pour le NUMLOCK.
Je n'y comprends plus rien !
Le GetKeyState ou GetAsyncKeyState retournent une valeur qui n'est pas toujours en lien avec la réalité.

 

[Dudu2]

@fanch55,

Il y a 3 méthodes classiques pour faire un SendKeys:

	Méthode [argument facultatif]	Impact possible sur NUMLOCK	Nativement synchrone (*)
1​	Sendkeys Keys [, Wait:=True | False]	Oui	Wait:=False -> Non Wait:=True -> Oui
2​	Application.SendKeys Keys [, Wait:=True | False]	Oui	Wait:=False -> Non Wait:=True -> Non
3​	CreateObject("wscript.shell").SendKeys Keys [, Wait:=True | False]	Non	Wait:=False -> Non Wait:=True -> Non

Pour la liste des touches se référer à la doc Microsoft.
(*) L'envoi des touches est terminé lorsqu'on passe à l'instruction VBA suivant le SendKeys

La méthode #3 est de très loin la plus simple à utiliser et il est facile de la rendre synchrone si besoin (voir ci-dessous).

Les méthodes #1 et #2 nécessitent une gestion du NUMLOCK complexe faisant appel à l'API Windows.
Voici un exemple de code pour information.

Option Explicit

'https://answers.microsoft.com/en-us/msoffice/forum/all/checking-for-numlock-status-fixing-numlock-status/1f85d47b-c368-4de8-becd-039f947a50ba?auth=1
'https://stackoverflow.com/questions/42440776/turning-numlock-on-at-the-end-of-a-macro-run
#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                                              ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As LongPtr) As Boolean
#Else
    Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                                      ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As Long) As Boolean
#End If

Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMLOCK As Byte = &H90
Private Const NumLockScanCode As Byte = &H45

'------------------------------------
'Set NUMLOCK à la valeur du paramètre
'------------------------------------
Private Sub ToggleNumlock(Enabled As Boolean)
    Dim KeyState(255) As Byte
 
    'Test current keyboard state.
    GetKeyboardState (VarPtr(KeyState(0)))
    If (Not CBool(KeyState(VK_NUMLOCK)) And Enabled) Or (CBool(KeyState(VK_NUMLOCK)) And Not Enabled) Then
        'Send a keydown
        keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY, 0&
        'Send a keyup
        keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0&
    End If
End Sub

'--------------------------
'Retourne l'état du NUMLOCK
'--------------------------
Private Function NumLockState() As Boolean
    Dim KeyState(255) As Byte
 
    GetKeyboardState (VarPtr(KeyState(0)))
    NumLockState = CBool(KeyState(VK_NUMLOCK))
End Function

'--------------------------
'Envoi de touches avec Wait
'--------------------------
Sub SendKeysWait(Keys As String)
    Dim NumLock As Boolean
 
    NumLock = NumLockState
    SendKeys Keys, Wait:=True
    Call ToggleNumlock(NumLock)
End Sub

Je rappelle que le SendKeys Keys, Wait:=True est la seule méthode qui permet nativement d'attendre que les touches soient effectivement envoyées avant de continuer le code de la macro. C'est un process synchrone.

Application.SendKeys Keys, Wait:=True ne le permet pas contrairement à ce que précise le paramètre Wait. Et encore moins évidemment CreateObject("wscript.shell").SendKeys (Keys).
L'asynchronisme de ces 2 méthodes n'a pas d'inconvénient si le code ne compte pas sur le résultat de l'action des touches envoyées, par exemple, juste avant de rendre la main à l'utilisateur.

Note: Pour rendre ces 2 méthodes synchrones il suffit d'ajouter un DoEvents après le SendKeys pour laisser le temps au système d'envoyer les touches avant de reprendre l'exécution du code VBA.

En effet, la doc de Doevents précise: «DoEvents cède le contrôle au système d’exploitation. Lorsque ce dernier à fini de traiter les événements de la file d’attente et que toutes les clés de la file d’attente SendKeys ont été envoyées, le processeur reprend le contrôle.»

Illustration:

Sub a()
    Dim i As Integer
 
    [A1].Value = "xyz"
    [A2].ClearContents
    [A1].Select

    'Envoi de 2600 caractères pour valoriser [A1]
    For i = 1 To 26
        CreateObject("wscript.shell").SendKeys String(100, Chr(96 + i))
    Next i
    CreateObject("wscript.shell").SendKeys "{ENTER}"
 
    DoEvents    'Laisse le temps au système d'envoyer tous les Sendkeys avant de reprendre le code VBA
    [A2].Value = [A1].Value '[A1] a bien reçu tous les caractères et donc [A2] peut les récupérer
                            'Sans le DoEvents, [A2] aurait la valeur précédente de [A1], c'est à dire "xyz"
    [A3].FormulaLocal = "=NBCAR(A2) & "" caractères en [A2]"""
End Sub

 

[patricktoulon]

Bonsoir tout les deux
comme je l'ai dis plus haut avec keybd_event le problème se pose plus puisque l'on gère l'appui et le relâchement de la touche ce que les autres ne font pas

 

[patricktoulon]

re

Ta méthode quoique plus longue en lignes de code fonctionne parfaitement.
Par contre, je ne suis plus notifié quand tu réagis aux post auxquels je participe ou crée !?

cela m' arrive aussi ,en effet , faudrait se rapprocher de David pour en connaitre la raison
perso j'ai activer le push donc même si je suis pas sur XLD j'ai les notifs

 

[Dudu2]

@patricktoulon
Appuyer sur les touches OK mais on veut envoyer "abc{ENTER}{UP}" on fait comment ?
Faut faire une fonction qui appuie et relâche chaque touche successivement en décodant tous les mots-clés du SendKeys ? Ou envoyer Enter et Up avec leurs codes directement ?

 

[patricktoulon]

re
Bonsoir @Dudu2
ben c'est simple j'ai donné un exemple déjà
les combinaisons tu les appui toutes et relâche toute (les une après les autres
et les suites tu les appui ET!!!!! relâche les une apres les autres

là c'est une suite donc
tu reprends ma fonction de base et ...

Function Xsendkeys(key, sens)
ExecuteExcel4Macro ("CALL(""user32"",""keybd_event"",""JJJJJ""," & key & ", " & 1 & ", " & sens & ", " & 0 & ")")     'api SetWindowLongA
DoEvents
End Function
Sub test2()
Xsendkeys 65, 0 'on apui sur la touche a
Xsendkeys 65, &H2 'on relache la touche a
Xsendkeys 66, 0 ' on apui sur la touche b
Xsendkeys 66, &H2 'on relache la touche b
Xsendkeys 67, 0 ' on apui sur la touche c
Xsendkeys 67, &H2 'on relache la touche c
Xsendkeys 13, 0 ' on apui sur la touche enter
Xsendkeys 13, &H2 'on relache la touche enter
Xsendkeys 38, 0 ' on apui sur la touche up
Xsendkeys 38, &H2 'on relache la touche up
End Sub

après on pourrait coder ça autrement pour se simplifier l'appel
c'est a dire prévoir dans la fonction le relâchement et un 3 eme argument piloterait le &h2(relâchement)

 

[Dudu2]

Je comprends pas !
65 c'est le code de 'A' pas de 'a'. Et pourtant ça affiche 'a'. C'est quoi le truc ?

De plus, cette séquence - si on exclu le {UP} - ne donne pas le même résultat qu'un SendKeys "abc{ENTER}"
Les lettres "abc" sont bien affichées dans une cellule mais c'est comme si elle n'existaient pas.
Soit au moment du Xsendkeys 13, soit par un ENTER clavier, elles disparaissent.

Je pense que ces fonctions permettent d'envoyer des codes spéciaux et ne peuvent pas être utilisées pour valoriser des cellules (au moins) et d'autres objets comme les TextBox, ComboBox, etc... (à vérifier).