Sendkey (1 Viewer)

[MarionD]

Morning,

I have a a bit of code on the presskey property in a form-

If KeyAscii = 44 Then
DoCmd.CancelEvent 'stop the comma keypress being updated
SendKeys ".", True 'put a full stop in the field
DoEvents
End If

which replaces the comma on the numder pad with a ".".

The reason being numerical codes have to be entered in a certain field, and the users would like to use just the number pad to enter these.
eg. "123.49" can be entered as 123,49 and the comma is replaced with a . - this works fine but my only problem is that the numlock is subsequently turned off- any ideas how I can prevent this from happening?

Thanks a million
Marion

 

[arnelgp]

then use the alternative vba of Dev Ashish and Arvin Meyer.
use the function fSendKeys(key, [bolWait]) as alternative:

Option Compare Database
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' author:
'
'   Dev Ashish and Arvin Meyer
'
' modified:
'
'   arnelgp
'   new VB7 and Win64 support
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' VERY GOOD, WORKING!
'
'******** 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 ***********

 

[cheekybuddha]

Probably simpler:

  If KeyAscii = 44 Then
    KeyAscii = 46     ' Substitute comma for a dot
  End If

hth,

d

 

[MarionD]

Thanks for the replies!

Arnelgp - the code is very impressive, but a bit complicated for what I want to do...

CheekyBuddha - it doesn't work? On keypress it doesn't stop the comma from being sent unless I use cancel event. Then I have to sendkeys to get it to insert the dot..... then the numlock is switched off for some reason...

 

[cheekybuddha]

Do you have the comma set as the decimal separator in your Regional Settings?

 

[MarionD]

Thanks guys - Problem solved:

Private Sub tblxx_Maschinen_ID_KeyPress(KeyAscii As Integer)
If KeyAscii = 44 Then
DoCmd.CancelEvent
SendKeys ".", True 'put a full stop in the field
End If
Call NumLock

End Sub

Public Function NumLock() As Boolean
NumLock = KeyState(kNumlock)
If (NumLock = True) Then
'MsgBox ("Num lock was off. Will turn back on now...")
SendKeys "{NUMLOCK}", True
Else:
'MsgBox ("Num Lock stayed on")
End If
End Function

Private Function KeyState(lKey As Long) As Boolean
KeyState = CBool(GetKeyState(lKey))
End Function

 

[cheekybuddha]

Glad you got it working!