发送密钥正在禁用NumLock

Question

问题:

当我使用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？

Answer 1

用它来重新打开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