JDE TO TAKTO
Příloha: 
12238_numlock.zip (24kB, staženo 38x)
12238_numlock.zip (24kB, staženo 38x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Tipy a triky pro Excel a makra VBA
< návrat zpět
Téma: Ovládání caps lock pomocí VBA
Uzamčeno - nelze přidávat nové příspěvky.
MS Excel
Téma: Ovládání caps lock pomocí VBA 
Zaslal/a Richard99 12.3.2013 14:27
Dobrý den,
potřeboval bych pomocí VBA přepínat klávesy caps lock a mumlock a možnost detekce stavu těchto kláves.
Uzamčeno - nelze přidávat nové příspěvky.
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 Sub
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 Sub
@Opičák
Jo SendKeys je lepší ;)
Ale dělá mi to stejnou neplechu, takže bych to stejně nepoužil ;) . A ani mne nenapadá k čemu.
Jo SendKeys je lepší ;)
Ale dělá mi to stejnou neplechu, takže bych to stejně nepoužil ;) . A ani mne nenapadá k čemu.
To eLCHa:
můj původní pokus byl na Win8, Off 2010, a klávesnici "bez numerické" a funguje všechno bez problémů
včera jsem to zkusil na Win7, Off 2007 a s numerickou klávesnicí a NIC, vůbec NIC
takže nevím
můj původní pokus byl na Win8, Off 2010, a klávesnici "bez numerické" a funguje všechno bez problémů
včera jsem to zkusil na Win7, Off 2007 a s numerickou klávesnicí a NIC, vůbec NIC
takže nevím
Re: Třídy klávesnice
Dík moc funguje to perfektně. Asi budu muset ještě hodně studovat, abych pochopil jak to funguje, ale použít se to dá.
Dík moc funguje to perfektně. Asi budu muset ještě hodně studovat, abych pochopil jak to funguje, ale použít se to dá.
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články