Forum Discussion

adlih's avatar
adlih
Copper Contributor
Jul 24, 2020

[ HELP ] VBA In a user form, a problem occur after I used [ SendKeys "{ }"]

VBA In a user form, 

I used [ SendKeys "{ }"],

Then

NumLock  AUTO DROP sometime =   = 

HOW TO prevent THAT? 

 

 

excel

5 Replies

    • adlih's avatar
      adlih
      Copper Contributor
      Jul 27, 2020

      Thank you for your message,
      but the problem still occur Subodh_Tiwari_sktneer 

       

      MY MAIN CODE HERE:

      Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
      If KeyCode = 13 Then
      CommandButton1_Click
      SendKeys "{LEFT}"
      Dim numLock As New NumLockClass
      If numLock.value = False Then numLock.value = True
      End If
      End Sub

      • Subodh_Tiwari_sktneer's avatar
        Subodh_Tiwari_sktneer
        Silver Contributor
        Jul 27, 2020

        adlih 

        You are right. After testing it multiple times I also found that the numlock gets turned off after regular intervals. SendKeys are notorious for this weird behavior. 

        I will let you know if I come across any workaround for this.

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Jul 24, 2020

    adlih 

     

    Please insert a Class Module and name it NumLockClass and then place the following code into the Class Module.

    #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 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
#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

     

    Then in your main code before End Sub check the status of NumLock with the following lines. This will turn on the NumLock it is turned off.

    Dim numLock As New NumLockClass
If numLock.value = False Then numLock.value = True

     

     

     

Resources