Sendkeys makes Numlock Toggle in RunCode Module (1 Viewer)

[MsAccessNL]

I have this Runcode module that i use a lot with coding. You can run a private event in the vbe editor. It only toggle the Numlock on and off. I tried a lot (with the code from this forum). I narrowed the problem down. The CheckNumlock function works, stand alone, but in the code beneath it always gives CheckNumlock False even it it is true. Sleep the code didn't help.

Public Sub RunCode()
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This Module is made by Daniel Sanders MsAccessNL 16-feb-2022
    ' First setfocus to Procedure then Type Runcode in the immediate window
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Const vbext_pk_Proc = 0
    Dim sProcedure As String, sFormName As String
    Dim lActiveLine As Long, sTemp As String
   
    Application.VBE.ActiveCodePane.GetSelection lActiveLine, 0, 0, 0 'get the activeLineNumber
    sFormName = Application.VBE.SelectedVBComponent.Name
    sProcedure = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(lActiveLine, vbext_pk_Proc)
   
    sTemp = "Call " & sFormName & "." & sProcedure
    SendKeys (sTemp), True ' False is default, True waits till kestroke is done
    SendKeys ("~"), True ' sometimes numlock will toggle
    'Sleep (500)
    Call CheckNumLock

End Sub

CheckNumlock function:

      Const VK_NUMLOCK = &H90
      Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Sub tblxx_Maschinen_ID_KeyPress(KeyAscii As Integer)

Public Function CheckNumLock() As Boolean

        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        CheckNumLock = keys(VK_NUMLOCK)
        Debug.Print CheckNumLock
        'If CheckNumLock = False Then ToggleNumLock
End Function

 

[arnelgp]

use this Alternative VBA:

Option Compare Database
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' author:
'
'   Dev Ashish and Arvin Meyer
'
' modified:
'
'   arnelgp
'   new VB7 and VBA7 support
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'******** Code Start ***********
      ' Declare Type for API call:
      Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128   '  Maintenance string for PSS usage
      End Type

      ' API declarations:
#If VBA7 Then
    Private Declare PtrSafe Function GetVersionEx Lib "kernel32" _
        Alias "GetVersionExA" ( _
            lpVersionInformation As OSVERSIONINFO) 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

    Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwFlags As Long, _
        ByVal dwExtraInfo As LongPtr)

#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

' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1

Function IsCapsLockOn() As Boolean
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsCapsLockOn = keys(VK_CAPITAL)
End Function

Sub ToggleCapsLock()
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
        'Toggle capslock
            keys(VK_CAPITAL) = Abs(Not keys(VK_CAPITAL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
          'Simulate Key Press>
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
          'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
               Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Function IsNumLockOn() As Boolean
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsNumLockOn = keys(VK_NUMLOCK)
End Function

Sub ToggleNumLock()
        Dim o As OSVERSIONINFO
                
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

          If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
                keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK))
                SetKeyboardState keys(0)
          ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
          '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 If
        
End Sub

Function IsScrollLockOn()
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsScrollLockOn = keys(VK_SCROLL)
End Function

Sub ToggleScrollLock()
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
            keys(VK_SCROLL) = Abs(Not keys(VK_SCROLL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
            'Simulate Key Press
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            'Simulate Key Release
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Private Sub mySendKeys(sKeys As String, Optional bWait As Boolean = False)
    Dim bNumLockState As Boolean
    Dim bCapsLockState As Boolean
    Dim bScrollLockState As Boolean
    bNumLockState = IsNumLockOn()
    bCapsLockState = IsCapsLockOn()
    bScrollLockState = IsScrollLockOn()
    SendKeys sKeys, bWait
    If IsNumLockOn() <> bNumLockState Then
        ToggleNumLock
    End If
    If IsCapsLockOn() <> bCapsLockState Then
        ToggleCapsLock
    End If
    If IsScrollLockOn() <> bScrollLockState Then
        ToggleScrollLock
    End If
End Sub

Function fSendKeys(sKeys As String, Optional bWait As Boolean = False)
' Function to make it callable from macros
    mySendKeys sKeys, bWait
End Function
'******** Code End ***********

 

[MsAccessNL]

Tried it , same outcome...

 

[arnelgp]

Tried it , same outcome...

did you use fSendKeys()?

 

[MsAccessNL]

It's a litte bit better. When numlock is on it stays on (it seems), but when numlock is off it turns back on (thats oke) but the run after it turns back off.
I noticed that the CheckNumLock code is ready before the Sendkeys are executed. May be there is an order of excecuting code. First the module before the code triggered from the immediate window. (sleep will not help)?