Excel VBA - make sure Numlock is always ON

4k Views Asked by At

I know this has been put to the attention before, but I can't solve it. I have a button that calls a sub and in that sub I want to make sure that numlock is always on. The first time, i.e. if the numlock is off it turns it on. If it's already on, clicking the button once or twice keeps the numlock on, but clicking a third time turns the numlock off. Clicking again keeps it off. Clicking again turns it on again. So every 3 clicks it turns it off. I don't understand how to fix it. I ahve Excel 2019 bit and Windows 10 64 bit. Here's the code:

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const kCapital = 20
Private Const kNumlock = 144

Public Function CapsLock() As Boolean
    CapsLock = KeyState(kCapital)
End Function

Public Function NumLock() As Boolean
    NumLock = KeyState(kNumlock)
End Function

Private Function KeyState(lKey As Long) As Boolean
    KeyState = CBool(GetKeyState(lKey))
End Function


Public Sub ToggleNumlock(choice As Boolean)
Application.Volatile

If choice = True Then
    If NumLock = False Then SendKeys "{NUMLOCK}", True
Else
    If NumLock = True Then SendKeys "{NUMLOCK}", True

End If
End Sub

In the sub triggered by the button I have:

Application.SendKeys "{F2}"

and just after I have

      If NumLock = False Then
       ToggleNumlock (True)
      End If

Could it be the Sendkeys that causes trouble? Because I need it, is there a workaround? Thank you.

UPDATE TO MY CODE:

ActiveSheet.Range(CurrentCell).Value = "=" 
ActiveSheet.Range(CurrentCell).Select
Application.SendKeys "{F2}", True
Application.SendKeys "=", True
Application.SendKeys "{F2}"

I removed all the code regarding the numlock on off, etc. and trying this it works for now at least on my machine: I just push the keys twice. I'll check this on my office machine tomorrow.

UPDATED 2021-07-19 In my office (Windows 64 localized italian, Excel 2010) I have the same problem with numlock that toggles BUT also the comma on the numpad becomes a point (in Italy it's 3,14 not 3.14). I GIVE UP. Thanks to all who tried to help me. MS must really fix sendkeys.

2

There are 2 best solutions below

5
On

Based on this article you can turn on Num Lock with the following code

Option Explicit
'https://www.vbarchiv.net/tipps/details.php?id=563

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer


Private Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
 
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_KEYUP = &H2

Sub pressNumLock()
    ' press NUM-Lock drücken
    ' first key down and then key-up
    keybd_event VK_NUMLOCK, 1, 0, 0
    keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End Sub

Sub NumLockOn()
    ' activate NUM-Lock (in case it is not activated)
    If Not (GetKeyState(vbKeyNumlock) = 1) Then
        pressNumLock
    End If
End Sub
0
On

Problem is here, simple correction seems to make it work.

Private Function KeyState(lKey As Long) As Boolean
'    KeyState = CBool(GetKeyState(lKey))
    KeyState = CLng(GetKeyState(lKey)) = 1
End Function