当我使用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?
答案 0 :(得分:5)
使用此功能重新打开numlock。我忘记了我在互联网上找到这个的地方。我没有创作。
NumLockClass
将其放在课程模块中。
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