问题
Issue:
Upon me using SendKeys
to copy data from an Excel application to another (non-Microsoft) application, my Num Lock becomes disabled.
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
Preferred Resolution:
What can be done to prevent my code from disabling the NumLock - or how can I go about re-enabling numlock once my code completes?
回答1:
Use this to turn numlock back on. I forget where I found this on the internet. I did not author it.
NumLockClass
Place this in a class module.
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
Use it like:
Dim numLock As New NumLockClass
If numLock.value = False Then numLock.value = True 'turn it back on
来源:https://stackoverflow.com/questions/38018232/send-keys-is-disabling-numlock