Thread: SendKeys

here's some code

Code:

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_CAPITAL = &H14
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2


Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

' API declarations:

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

Public Sub ToggleCapsLock(bTurnOn As Boolean)

    'To turn capslock on, set bTurnOn to true
    'To turn capslock off, set bTurnOn to false

    Dim bytKeys(255) As Byte
    Dim bCapsLockOn As Boolean

    'Get status of the 256 virtual keys
    GetKeyboardState bytKeys(0)

    bCapsLockOn = bytKeys(VK_CAPITAL)
    Dim typOS  As OSVERSIONINFO

    If bCapsLockOn <> bTurnOn Then   'if current state <>
        'requested state

        If typOS.dwPlatformId = _
           VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98

            bytKeys(VK_CAPITAL) = 1
            SetKeyboardState bytKeys(0)

        Else    '=== WinNT/2000

            '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 If


End Sub

Sub switchOn()
    ToggleCapsLock (True)
End Sub

Sub switchOff()
    ToggleCapsLock (False)
End Sub

I was pondering why OT's code didn't work; and then it occurred to me that Caps Lock and Num Lock never make it out of the keyboard driver -- Excel wouldn't know what to do with them.

Hello OptionTrader,

Here is a more succinct version of the API send keys.

VBA Module Code

Code:

'Written: January 17, 2010
'Author:  Leith Ross
'Summary: API routines to set or clear the CAPS, NUM LOCK and SCOLL keys.

Option Explicit

Const NumLock_On = &H20
Const ScrollLock_On = &H40
Const CapsLock_On = &H80
Const vk_Scroll = &H91

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

Private Declare Function GetKeyState _
  Lib "user32.dll" _
    (ByVal nVirtKey As Long) As Long

Sub KeyLock(myKey As String, State As Boolean)
 'State=True means to press key if state is off
 'myKey must be: Num, Scroll, or Caps as String type.

  Select Case True
    Case myKey Like "Num"
      If State <> CBool(GetKeyState(vbKeyNumlock)) Then PressKey (vbKeyNumlock)
    Case myKey Like "Scroll"
      If State <> CBool(GetKeyState(vk_Scroll)) Then PressKey (vk_Scroll)
    Case myKey Like "Caps"
      If State <> CBool(GetKeyState(vbKeyCapital)) Then PressKey (vbKeyCapital)
  End Select
  
End Sub

Sub PressKey(theKey As Long)
  keybd_event theKey, 0, 0, 0 'press key
  keybd_event theKey, 0, &H2, 0 'release key
End Sub

ThisWorkbook_Open Event Code

Code:

Private Sub Workbook_Open()
 'Lock these keys
  KeyLock "Caps", True
  KeyLock "Num Lock", True
End Sub

Hello OptionTrader,

When dealing with API calls and most other code, it helps to know what Operating System you have. You should update your profile to include which operating systems you use. Roy's checks your operating system, that why his working. So, I can assume you are not using Windows 2000 through Windows XP.

Just searched through the code on another computer & found this

Code:

Option Explicit

Private Declare Function GetKeyboardState Lib "user32" _
      (pbKeyState As Byte) As Long
Private Declare Function GetKeyState Lib "user32" _
      (ByVal nVirtKey As Long) As Integer
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 SetKeyboardState Lib "user32" _
      (lppbKeyState As Byte) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
   
Private Const VK_CAPS = &H14
Private Const VK_NUM = &H90
Private Const VK_SCROLL = &H91
Private keys(0 To 255) As Byte
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Private oSv As OSVERSIONINFO
Private Function KeyStatus(Test) As Boolean
    Dim bInsertKeyState As Boolean
    oSv.dwOSVersionInfoSize = Len(oSv)
    GetVersionEx oSv
    GetKeyboardState keys(0)
    KeyStatus = keys(Test)
End Function
Private Sub Switch(Test, Switch As Boolean)
    If (KeyStatus(Test) <> Switch) Then
        If (oSv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) Then
            keys(Test) = 1
            SetKeyboardState keys(0)
        ElseIf (oSv.dwPlatformId = VER_PLATFORM_WIN32_NT) Then
            keybd_event Test, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            keybd_event Test, &H45, KEYEVENTF_EXTENDEDKEY Or _
            KEYEVENTF_KEYUP, 0
        End If
    End If
End Sub
Public Sub On()
    Switch VK_NUM, 1
    Switch VK_CAPS, 1
    Switch VK_SCROLL, 1
End Sub
Public Sub Off()
    Switch VK_NUM, 0
    Switch VK_CAPS, 0
    Switch VK_SCROLL, 0
End Sub
Public Sub Status()
    MsgBox "Num : " & KeyStatus(VK_NUM) & vbNewLine & _
           "Caps: " & KeyStatus(VK_CAPS) & vbNewLine & _
           "Scroll: " & KeyStatus(VK_SCROLL), vbInformation, "Test status"
End Sub

sorry wrong page

Originally Posted by OptionTrader

Roy, is there any chance you could include the code to also switch on the CapsLock? I'd be most grateful.

Martin

That's in the first code that I posted and in the second