AW: Nummerischen-Block deaktivieren
17.08.2003 14:55:05
Ramses
Hallo Ulf, hallo Matthias,
bevor ich diese Frage hier stellte, habe ich im Archiv die
unten stehenden Lösungen gefunden ("siehe Anhang"). Leider, wie sagt man so schön,
funzt das nicht. Vieleicht mache ich auch etwas falsch beim einfügen
des Codes. Wer kann mir helfen. Es ist mir wichtig, daß Eingaben über
den "Nummerischen-Block" nicht möglich sind. Alle anderen Tasteneingabe-
möglichkeiten sind derzeit schon gesperrt.
Danke für Eure Hilfe
Mit Gruß
Anhang:
Hallo,
probier mal das.
Ich weiss aber nicht mehr von wem das ist.
'-----------------------------------------------
'Funktion um die NUM-Lock Taste einzuschalten bzw. auszuschalten
Die Funktion "SwitchNumLock()" erwartet als Parameter "Wahr/True", wenn NumLock eingeschaltet und "Falsch/False",
wenn NumLock ausgeschaltet werden soll. Um die Funktion "SwitchNumLock()" an die betreffenden Felder zu binden, öffnen Sie das jeweilige Formular im Entwurfsmodus,
'markieren der Reihe nach die gewünschten Felder und setzen die folgenden Eigenschaften:
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
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Function SwitchNumLock(OnOff As Boolean) As Boolean
Dim ovi As OSVERSIONINFO
Dim R As Variant
Dim NumLockOn As Boolean
Dim KeyTable(0 To 255) As Byte
'Länge der Struktur setzen
ovi.dwOSVersionInfoSize = Len(ovi)
'Versionsinfos holen
R = GetVersionEx(ovi)
'Tastaturstatus holen
R = GetKeyboardState(KeyTable(0))
'Aktueller Status, True|False
NumLockOn = (KeyTable(VK_NUMLOCK) <> 0)
If ovi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
'Windows NT, 2000, XP
If (OnOff And Not NumLockOn) Or (Not OnOff And NumLockOn) Then
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
Else
'Windows 9.x/ME
If OnOff Then
KeyTable(VK_NUMLOCK) = 1
Else
KeyTable(VK_NUMLOCK) = 0
End If
R = SetKeyboardState(KeyTable(0))
End If
End Function
'Bei Fokuserhalt:=SwitchNumLock(Wahr)
'Bei Fokusverlust:=SwitchNumLock(Falsch)
'In Zukunft wird nun die NumLock-Funktion für die eben geänderten Felder
'beim Aktivieren ein- und beim Verlassen wieder ausgeschaltet.
'Möchten Sie NumLock generell beim Laden des Formulars einschalten, so nehmen Sie
'in der Ereignisprozedur "Beim Laden" (Form_Load) zum Beispiel einen Aufruf wie folgt vor:
Sub Form_Load()
Dim R As Variant
R = SwitchNumLock(True)
End Sub
'Ende der Funktion
'------------------------------------------------------------------------------------
Code eingefügt mit Syntaxhighlighter 1.16
Gruss Rainer
Betrifft: AW: NUM LOCK
Hallo oschiewek
Rainer hat ja schon ausführlich geantwortet aber hier auch noch was aus meinem Archiv
[VBA] NumLock über VBA abfragen
versuch's mal mit folgendem API (muss am Anfang eines Moduls stehen)
Const VK_NUMLOCK = &H90
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private kbArray As KeyboardBytes
Private Declare
Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare
Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Sub Numlock_aus()
GetKeyboardState kbArray
If kbArray.kbByte(VK_NUMLOCK) = 1 Then
MsgBox "Numlock ist eingeschaltet.", vbOKOnly + vbInformation, "Eingeschaltet"
Else
MsgBox "Numlock ist ausgeschaltet.", vbOKOnly + vbInformation, "Ausgeschaltet"
End If
kbArray.kbByte(VK_NUMLOCK) = 0
SetKeyboardState kbArray
End Sub
von Jörg Lorenz
[VBA] Numlock ein-/ausschalten
versuch's mal mit folgendem API (muss am Anfang eines Moduls stehen):
Const VK_NUMLOCK = &H90
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private kbArray As KeyboardBytes
Private Declare
Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare
Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Sub Numlock_ein()
GetKeyboardState kbArray
kbArray.kbByte(VK_NUMLOCK) = 1
SetKeyboardState kbArray
End Sub
Sub Numlock_aus()
GetKeyboardState kbArray
kbArray.kbByte(VK_NUMLOCK) = 0
SetKeyboardState kbArray
End Sub
Sub Numlock_umkehren()
GetKeyboardState kbArray
kbArray.kbByte(VK_NUMLOCK) = IIf(kbArray.kbByte(VK_NUMLOCK) = 1, 0, 1)
SetKeyboardState kbArray
End Sub
von Jörg Lorenz
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.
Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.
Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.
Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.
Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.
Betrifft: AW: NUM LOCK
ich danke euch. hat mir leider nicht viel weitergeholfen.
scheint mir sehr kompliziert, da verscheidene windows-versionen
berücksichtigt werden müssen.
eine einfachere lösung gibt es wohl leider nicht.
trotzdem danke!
olaf
Betrifft: Danke fürs Feedback....
Hallo,
... aber einfacher geht es nun wirklich nicht :-)
Dabei greift man tief ins Betriebssystem ein und das geht nur auf diesem Wege.
Gruss Rainer