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

Copper Contributor

VBA In a user form, 

I used [ SendKeys "{ }"],

Then

NumLock  AUTO DROP sometime =   = 

HOW TO prevent THAT? 

 

 

5 Replies

@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

 

 

 

@adlih 

Refer to the following screenshot to know how to rename a Class Module.

Class Module.jpg

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

@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.