17.09.2023, 18:12
Liebe Leserin, lieber Leser,
Nutzer von SendKeys zum Senden von Tastenanschlägen haben oft das Problem, dass sich die Numlock-Tasteneinstellung unregelmäßig ändert. Sie wird also ungewünscht ein- oder ausgeschaltet.
Mit nachfolgendem Code kann das behoben werden. Die zweite Alternative ist m.E. weniger anfällig und reicht ggf. schon, der erste code stellt die Numlockeinstellung auf jeden Fall wieder her.
Nutzer von SendKeys zum Senden von Tastenanschlägen haben oft das Problem, dass sich die Numlock-Tasteneinstellung unregelmäßig ändert. Sie wird also ungewünscht ein- oder ausgeschaltet.
Mit nachfolgendem Code kann das behoben werden. Die zweite Alternative ist m.E. weniger anfällig und reicht ggf. schon, der erste code stellt die Numlockeinstellung auf jeden Fall wieder her.
Code:
Private Declare PtrSafe Function GetKeyboardState Lib "user32" ( _
pbKeyState As Byte) As Long
Sub SendMyKeys(Was As String, Optional bWait As Boolean)
' Nummernblockeinstellung merken, SendKeys abschicken,
' Nummernblock ggf. wiederherstellen
' GetKeyboardState Keys(0) Keyboard-Array füllen
Dim Keys(0 To 255) As Byte, bNumBlock As Byte
GetKeyboardState Keys(0): bNumBlock = Keys(vbKeyNumlock)
SendKeys Was, bWait
GetKeyboardState Keys(0)
If bNumBlock <> Keys(vbKeyNumlock) Then SendKeys "{NUMLOCK}"
End Sub
' oder diese Alternative hier
Sub Test2()
CreateObject("WScript.Shell").SendKeys "^v", True
End Sub
' ######## Aufruftest ##########
Sub TestSendKeys()
SendMyKeys "^v", True
End Sub
' ##############################
pbKeyState As Byte) As Long
Sub SendMyKeys(Was As String, Optional bWait As Boolean)
' Nummernblockeinstellung merken, SendKeys abschicken,
' Nummernblock ggf. wiederherstellen
' GetKeyboardState Keys(0) Keyboard-Array füllen
Dim Keys(0 To 255) As Byte, bNumBlock As Byte
GetKeyboardState Keys(0): bNumBlock = Keys(vbKeyNumlock)
SendKeys Was, bWait
GetKeyboardState Keys(0)
If bNumBlock <> Keys(vbKeyNumlock) Then SendKeys "{NUMLOCK}"
End Sub
' oder diese Alternative hier
Sub Test2()
CreateObject("WScript.Shell").SendKeys "^v", True
End Sub
' ######## Aufruftest ##########
Sub TestSendKeys()
SendMyKeys "^v", True
End Sub
' ##############################
_________
viele Grüße
Karl-Heinz
viele Grüße
Karl-Heinz