Отправка ключей отключает 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

Answer 2

Вот модуль NumLock, чтобы вы могли легко проверить и изменить положение клавиш NumLock.

Это было основано на ответе findwindow, затем я исправил некоторые ошибки, упростил использование и оптимизировал, так что теперь у вас есть глобальное свойство Numlock вместо необходимости экземпляра объекта класса:

Модуль 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