vor einigen Tagen habe ich eine aktualisierte Version meiner Sudoku-Spielerei hier veröffentlicht. Darin gibt es ein Problem, das es eigentlich nicht geben dürfte: Irgendeine meiner Prozeduren, Aufrufe, was auch immer schaltet meinen Ziffernblock, den NumLock aus. Die Ursache konnte ich auch mit gründlicher Suche nicht finden. Also hatte ich in der alten Version eine sehr aufwändige Routine, die das verhindert. Schließlich ist XL eine Tabellenkalkulation, die mit Zahlen arbeitet.
Hier nun (mal wieder als Spickzettel) ein deutlich schlankere Version zur Kontrolle des NumLocks. Der Code in ein Allg. Modul, der Aufruf von beliebiger Stelle.
Code: Alles auswählen
Option Explicit
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
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
Function SetNumLock(bStatus As Boolean) As Boolean
Dim bKey As Byte, bKeyTable(0 To 255) As Byte
Dim isNumLock As Boolean
bKey = GetKeyboardState(bKeyTable(0))
isNumLock = (bKeyTable(VK_NUMLOCK) <> 0)
If (bStatus And Not isNumLock) Or (Not bStatus And isNumLock) Then
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End Function
Sub KeyOn()
SetNumLock True
End Sub