Vyzkoušejte následující. Čtení stavu funguje, změna stavu by měla taky, ale u mne se to chová divně. Buď je to tím, že mám 64bit počítač, klávesnici přes USB nebo tam mám chybu ;)
V každém případě je třeba použít tyto API funkce, takže googlete a řešení se najde.
Private Type typeKeyboardBytes
bBytes(0 To 255) As Byte
End Type
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As typeKeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As typeKeyboardBytes) As Long
Const KEY_NUMLOCK As Long = &H90
Const KEY_CAPSLOCK As Long = &H14
Const KEY_SCROLLLOCK As Long = &H91
Sub subGetKeys()
Debug.Print "NumLock: " & (GetKeyState(KEY_NUMLOCK) = 1)
Debug.Print "CapsLock: " & (GetKeyState(KEY_CAPSLOCK) = 1)
Debug.Print "ScrollLock: " & (GetKeyState(KEY_SCROLLLOCK) = 1)
End Sub
Sub subChangeKeys()
Call subChangeKeyState(KEY_NUMLOCK, Not (GetKeyState(KEY_NUMLOCK) = 1))
Call subChangeKeyState(KEY_CAPSLOCK, Not (GetKeyState(KEY_CAPSLOCK) = 1))
Call subChangeKeyState(KEY_SCROLLLOCK, Not (GetKeyState(KEY_SCROLLLOCK) = 1))
End Sub
Private Sub subChangeKeyState(ByVal key As Long, ByVal bValue As Boolean)
Dim keysStatus As typeKeyboardBytes
GetKeyboardState keysStatus
keysStatus.bBytes(key) = Abs(CInt(bValue))
SetKeyboardState keysStatus
End Subcitovat