发送键禁用 NumLock
Send Keys is Disabling NumLock
问题：
当我使用 SendKeys 将数据从 Excel 应用程序复制到另一个（非 Microsoft）应用程序时，我的 Num Lock 被禁用。
Sub Test()
Range("A1:B71").Select
SendKeys "^C" 'Copies Selected Text
AppActivate "AccuTerm 2K2"
SendKeys "2", True 'Enters to notes screen
SendKeys "^M", True 'Confirms above (Enter key)
SendKeys "^V", True 'Pastes into client application
Application.Wait (Now + TimeValue("0:00:05"))
'Providing time for client application to finish
'pasting...
SendKeys "^M", True 'Next three enters are to
SendKeys "^M", True '...exit notes section
SendKeys "^M", True
AppActivate "Microsoft Excel"
Range("B52:B62").Clear 'Clears the Template
Range("B52").Select 'Resets Cell Position
End Sub
首选分辨率：
如何防止我的代码禁用 NumLock - 或者我如何在代码完成后重新启用 numlock？
使用它重新打开数字锁定。我忘了我在互联网上找到这个的地方。我没有创作它。
NumLockClass
将其放在 class 模块中。
Option Explicit
' API declarations
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare PtrSafe Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
#Else
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
#End If
' Type declaration
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'Constant declarations
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Property Get value() As Boolean
' Get the current state
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
value = keys(VK_NUMLOCK)
End Property
Property Let value(boolVal As Boolean)
Dim o As OSVERSIONINFO
Dim keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
' Is it already in that state?
If boolVal = True And keys(VK_NUMLOCK) = 1 Then Exit Property
If boolVal = False And keys(VK_NUMLOCK) = 0 Then Exit Property
' Toggle it
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Property
Sub Toggle()
' Toggles the state
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Sub
像这样使用它：
Dim numLock As New NumLockClass
If numLock.value = False Then numLock.value = True 'turn it back on
这里有一个NumLock模块，方便您查看和修改NumLock键位情况
这是基于 findwindow 的回答，然后我修复了一些错误，简化了使用并进行了优化，所以现在你有了全局 Numlock 属性 而不是需要实例化一个 class 对象：
NumLock 模块:
Option Explicit
' API declarations
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub keybd_event Lib "USER32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, _
ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal nVKey As Long) As Integer
#Else
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function GetKeyState Lib "USER32" (ByVal nVKey As Long) As Integer
#End If
'Constant declarations
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
'===================================================================
'PROPERTIES
'
'=========================================
'Returns the current Numlock state
Public Property Get Numlock() As Boolean
Numlock = Numlock_State
End Property
'=========================================
'Sets the Numlock state
' true = turn numlock on
' false = turn numlock off
Public Property Let Numlock(State As Boolean)
If State <> Numlock_State Then Numlock_Toggle
End Property
'===================================================================
'METHODS
'
'=========================================
'Returns the current Numlock state
Private Function Numlock_State() As Boolean
DoEvents 'Required for key messages to be processed
Numlock_State = CBool(GetKeyState(VK_NUMLOCK))
End Function
'=========================================
'Sets the Numlock state
'
' State: true = turn numlock on
' false = turn numlock off
Private Sub Numlock_Set(State As Boolean)
If State <> Numlock_State Then Numlock_Toggle
End Sub
'=========================================
'Toggles the Numlock state
Public Sub Numlock_Toggle()
Dim previous_state As Boolean
previous_state = Numlock_State
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY, 0 'Simulate Numlock key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0 'Simulate Numlock key Release
End Sub
用法示例：
Public Sub Example()
'Turn Numlock on:
Numlock = True
'Turn Numlock off:
Numlock = False
'Check Numlock state:
Dim IsOn As Boolean
IsOn = Numlock
'Toggle Numlock state:
Numlock_Toggle
End Sub
问题：
当我使用 SendKeys 将数据从 Excel 应用程序复制到另一个（非 Microsoft）应用程序时，我的 Num Lock 被禁用。
Sub Test()
Range("A1:B71").Select
SendKeys "^C" 'Copies Selected Text
AppActivate "AccuTerm 2K2"
SendKeys "2", True 'Enters to notes screen
SendKeys "^M", True 'Confirms above (Enter key)
SendKeys "^V", True 'Pastes into client application
Application.Wait (Now + TimeValue("0:00:05"))
'Providing time for client application to finish
'pasting...
SendKeys "^M", True 'Next three enters are to
SendKeys "^M", True '...exit notes section
SendKeys "^M", True
AppActivate "Microsoft Excel"
Range("B52:B62").Clear 'Clears the Template
Range("B52").Select 'Resets Cell Position
End Sub
首选分辨率：
如何防止我的代码禁用 NumLock - 或者我如何在代码完成后重新启用 numlock？
使用它重新打开数字锁定。我忘了我在互联网上找到这个的地方。我没有创作它。
NumLockClass
将其放在 class 模块中。
Option Explicit
' API declarations
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare PtrSafe Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
#Else
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
#End If
' Type declaration
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'Constant declarations
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Property Get value() As Boolean
' Get the current state
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
value = keys(VK_NUMLOCK)
End Property
Property Let value(boolVal As Boolean)
Dim o As OSVERSIONINFO
Dim keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
' Is it already in that state?
If boolVal = True And keys(VK_NUMLOCK) = 1 Then Exit Property
If boolVal = False And keys(VK_NUMLOCK) = 0 Then Exit Property
' Toggle it
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Property
Sub Toggle()
' Toggles the state
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Sub
像这样使用它：
Dim numLock As New NumLockClass
If numLock.value = False Then numLock.value = True 'turn it back on
这里有一个NumLock模块，方便您查看和修改NumLock键位情况
这是基于 findwindow 的回答，然后我修复了一些错误，简化了使用并进行了优化，所以现在你有了全局 Numlock 属性 而不是需要实例化一个 class 对象：
NumLock 模块:
Option Explicit
' API declarations
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub keybd_event Lib "USER32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, _
ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal nVKey As Long) As Integer
#Else
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function GetKeyState Lib "USER32" (ByVal nVKey As Long) As Integer
#End If
'Constant declarations
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
'===================================================================
'PROPERTIES
'
'=========================================
'Returns the current Numlock state
Public Property Get Numlock() As Boolean
Numlock = Numlock_State
End Property
'=========================================
'Sets the Numlock state
' true = turn numlock on
' false = turn numlock off
Public Property Let Numlock(State As Boolean)
If State <> Numlock_State Then Numlock_Toggle
End Property
'===================================================================
'METHODS
'
'=========================================
'Returns the current Numlock state
Private Function Numlock_State() As Boolean
DoEvents 'Required for key messages to be processed
Numlock_State = CBool(GetKeyState(VK_NUMLOCK))
End Function
'=========================================
'Sets the Numlock state
'
' State: true = turn numlock on
' false = turn numlock off
Private Sub Numlock_Set(State As Boolean)
If State <> Numlock_State Then Numlock_Toggle
End Sub
'=========================================
'Toggles the Numlock state
Public Sub Numlock_Toggle()
Dim previous_state As Boolean
previous_state = Numlock_State
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY, 0 'Simulate Numlock key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0 'Simulate Numlock key Release
End Sub
用法示例：
Public Sub Example()
'Turn Numlock on:
Numlock = True
'Turn Numlock off:
Numlock = False
'Check Numlock state:
Dim IsOn As Boolean
IsOn = Numlock
'Toggle Numlock state:
Numlock_Toggle
End Sub