简体   繁体   中英

Excel VBA - make sure Numlock is always ON

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM