VBA编辑器运行宏时SendKeys干扰NumLock，NumLockClass检测失效如何解决

问题原因 #

原NumLockClass类模块默认使用GetKeyStateAPI读取NumLock状态，该API仅返回当前VBA线程内部维护的键盘状态缓存，仅会同步本线程内触发的状态变更。而SendKeys触发的NumLock状态修改是系统级别的硬件状态变更，不会主动同步到VBA线程的键盘状态缓存，因此类模块读取到的仍是修改前的旧值，无法匹配真实状态。

解决方法 #

步骤1：修改NumLockClass的API调用逻辑

将类模块中原有的GetKeyState声明替换为GetAsyncKeyState，该API会直接读取键盘硬件的实时状态，不受线程缓存影响。兼容32/64位Office的完整类模块代码如下：

#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_KEYUP = &H2

' 读取NumLock实时状态
Public Property Get Value() As Boolean
    Value = (GetAsyncKeyState(VK_NUMLOCK) And 1) = 1
End Property

' 设置NumLock状态
Public Property Let Value(newVal As Boolean)
    If Me.Value <> newVal Then
        ' 按下NumLock键
        keybd_event VK_NUMLOCK, &H45, 0, 0
        ' 松开NumLock键
        keybd_event VK_NUMLOCK, &H45, KEYEVENTF_KEYUP, 0
    End If
End Property

步骤2：优化SendKeys调用逻辑

每次调用SendKeys后添加DoEvents语句，主动同步系统状态变更到VBA线程，避免读取延迟。如果需要彻底避免NumLock状态被SendKeys篡改，还可以在调用前后保存并恢复状态，修改后的test宏代码如下：

Dim numLock As New NumLockClass

Sub test()
    Do
        If numLock.Value = False Then
            k = InputBox("NumLock is deactivated, pressing digit keys in the Numeric Pad does nothing." & vbCrLf & "- Type 'a' to activate NumLock" & vbCrLf & "- Type 'e' to type Ctrl+End")
        Else
            k = InputBox("NumLock is activated, press digit keys in the Numeric Pad to type a number." & vbCrLf & "- Type 'd' to deactivate NumLock" & vbCrLf & "- Type 'e' to type Ctrl+End")
        End If
        If k = "a" Then
            numLock.Value = True
        ElseIf k = "d" Then
            numLock.Value = False
        ElseIf k = "e" Then
            ' 保存执行前的NumLock状态
            Dim preState As Boolean
            preState = numLock.Value
            SendKeys "^{END}"
            ' 同步系统状态
            DoEvents
            ' 恢复原有NumLock状态
            If numLock.Value <> preState Then
                numLock.Value = preState
            End If
        Else
            Exit Sub
        End If
    Loop
End Sub

修改完成后类模块即可正确读取NumLock的真实状态，也不会出现SendKeys篡改NumLock状态影响用户使用的问题。

内容的提问来源于stack exchange，提问作者Sandra Rossi