vba - 发送 key 正在禁用 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