NUM LOCK

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: NUM LOCK

16.08.2003 12:07:48

Ramses

AW: NUM LOCK

16.08.2003 12:48:45

Hajo_Zi

AW: NUM LOCK

17.08.2003 13:42:23

oschiewek

Danke fürs Feedback....

17.08.2003 14:55:05

Ramses

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

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.

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread