'Type declaration'https://books.google.com.tw/books?id=dtSdrjjVXrwC&lpg=PA896&ots=yVl9armuTo&dq=vba%20numlock%20toggle&hl=zh-TW&pg=PA896#v=onepage&q&f=false
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'API declarations
Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare PtrSafe Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
'Constant declarations
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Property Get Value() As Boolean
'Get the current state
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
Value = keys(VK_NUMLOCK)
End Property
Property Let Value(boolVal As Boolean)
Dim o As OSVERSIONINFO
Dim keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
'Is it already in that state?
If boolVal = True And keys(VK_NUMLOCK) = 1 Then Exit Property
If boolVal = False And keys(VK_NUMLOCK) = 0 Then Exit Property
'Toggle it
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Property
Sub Toggle()
'Toggles the state
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
End Sub
'=============
'https://books.google.com.tw/books?id=dtSdrjjVXrwC&lpg=PA896&ots=yVl9armuTo&dq=vba%20numlock%20toggle&hl=zh-TW&pg=PA896#v=onepage&q&f=false
Sub NumLockOn()
Dim NumLock As New NumLockClass
NumLock.Value = True
End Sub
Sub GetNumLockState()
Dim NumLock As New NumLockClass
MsgBox NumLock.Value
End Sub
Sub ToggleNumLock()
Dim NumLock As New NumLockClass
NumLock.Toggle
End Sub
Sub ToggleNumLock2()
Dim NumLock As New NumLockClass
NumLock.Value = Not NumLock.Value
End Sub