VBA中检测键盘控制键(Shift Control Alt)状态

VBA编写的程序中，经常需要提供一些功能键或者快捷键或者是辅助键，比如Shift|Control|Alt，以方便用户更方便使用你的程序。VBA中并没有相关函数来完成检测键盘控制键状态的函数，因此，必须使用Windows API函数GetKeyState。GetKeyState函数会返回某个指定按键的状态(按下或者未按下)。水文工具集提供VBA编写的3个相关函数，可以方便你在代码中使用，用以完成相关功能。

IsShiftKeyDown：检测Shift控制键状态

IsControlKeyDown：检测Control控制键状态

IsAltKeyDown：检测Alt控制键状态

上面的函数返回True或者False，当指定按键按下时返回True，而未按下时返回False。

函数的定义如下：

Public Function IsShiftKeyDown( _
  Optional LeftOrRightKey As Long = LeftKeyOrRightKey _
  ) As Boolean

Public Function IsControlKeyDown( _
  Optional LeftOrRightKey As Long = LeftKeyOrRightKey _
  ) As Boolean

Public Function IsAltKeyDown( _
  Optional LeftOrRightKey As Long = LeftKeyOrRightKey _
  ) As Boolean

上面的函数都有一个可选的参数来指定是检测只有左边或者只有右边或者两者其一或者同时按下控制键，默认是左边右边两者其一，具体的可选参数有下面的类型：

    Public Const BothLeftAndRightKeys = 0    
    ' BOTH left and right together
    Public Const LeftKey = 1                
    ' LEFT key only
    Public Const RightKey = 2                
    ' RIGHT key only
    Public Const LeftKeyOrRightKey = 3      
    ' EITHER left or right or BOTH

当然如果加以修改，一样可以用来其它功能键。

VBA中检测键盘控制键(Shift Control Alt)状态具体源代码如下：

'================================
' VBA中检测键盘控制键(Shift Control Alt)状态
'
' 
'================================
Option Explicit
Option Compare Text

Private Declare Function GetKeyState Lib "user32" ( _
    ByVal nVirtKey As Long) As Integer

Private Const KEY_MASK As Integer = &HFF80 ' decimal -128

Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1
Private Const VK_LCONTROL = &HA2
Private Const VK_RCONTROL = &HA3
Private Const VK_LMENU = &HA4
Private Const VK_RMENU = &HA5

Private Const VK_LALT = VK_LMENU
Private Const VK_RALT = VK_RMENU
Private Const VK_LCTRL = VK_LCONTROL
Private Const VK_RCTRL = VK_RCONTROL

Public Const BothLeftAndRightKeys = 0   
Public Const LeftKey = 1
Public Const RightKey = 2
Public Const LeftKeyOrRightKey = 3      

Public Function IsShiftKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean
    Dim Res As Long
    
    Select Case LeftOrRightKey
        Case LeftKey
            Res = GetKeyState(VK_LSHIFT) And KEY_MASK
        Case RightKey
            Res = GetKeyState(VK_RSHIFT) And KEY_MASK
        Case BothLeftAndRightKeys
            Res = (GetKeyState(VK_LSHIFT) And GetKeyState(VK_RSHIFT) And KEY_MASK)
        Case Else
            Res = GetKeyState(vbKeyShift) And KEY_MASK
    End Select
    
    IsShiftKeyDown = CBool(Res)
End Function

Public Function IsControlKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean
    Dim Res As Long
    
    Select Case LeftOrRightKey
        Case LeftKey
            Res = GetKeyState(VK_LCTRL) And KEY_MASK
        Case RightKey
            Res = GetKeyState(VK_RCTRL) And KEY_MASK
        Case BothLeftAndRightKeys
            Res = (GetKeyState(VK_LCTRL) And GetKeyState(VK_RCTRL) And KEY_MASK)
        Case Else
            Res = GetKeyState(vbKeyControl) And KEY_MASK
    End Select
    
    IsControlKeyDown = CBool(Res)

End Function

Public Function IsAltKeyDown(Optional LeftOrRightKey As Long = LeftKeyOrRightKey) As Boolean
    Dim Res As Long
    
    Select Case LeftOrRightKey
        Case LeftKey
            Res = GetKeyState(VK_LALT) And KEY_MASK
        Case RightKey
            Res = GetKeyState(VK_RALT) And KEY_MASK
        Case BothLeftAndRightKeys
            Res = (GetKeyState(VK_LALT) And GetKeyState(VK_RALT) And KEY_MASK)
        Case Else
            Res = GetKeyState(vbKeyMenu) And KEY_MASK
    End Select
    
    IsAltKeyDown = CBool(Res)

End Function

下面代码是调用了上面函数的一个测试，我们可以从VBA编辑器的调试窗口中看到相关控制键状态。

Sub Test()
    Application.OnTime Now + TimeSerial(0, 0, 2), "ProcTest", , True
End Sub

Sub ProcTest()
Debug.Print "SHIFT KEY: ",  _
 "LEFT: " & CStr(IsShiftKeyDown(LeftKey)), _
 "RIGHT: " & CStr(IsShiftKeyDown(RightKey)), _
 "EITHER: " & CStr(IsShiftKeyDown(LeftKeyOrRightKey)), _
 "BOTH:   " & CStr(IsShiftKeyDown(BothLeftAndRightKeys))
                        
Debug.Print "ALT KEY:   ",  _
 "LEFT: " & CStr(IsAltKeyDown(LeftKey)), _
 "RIGHT: " & CStr(IsAltKeyDown(RightKey)), _
 "EITHER: " & CStr(IsAltKeyDown(LeftKeyOrRightKey)), _
 "BOTH:   " & CStr(IsAltKeyDown(BothLeftAndRightKeys))
                        
Debug.Print "CTRL KEY:   ", _
 "LEFT: " & CStr(IsControlKeyDown(LeftKey)), _
 "RIGHT: " & CStr(IsControlKeyDown(RightKey)), _
 "EITHER: " & CStr(IsControlKeyDown(LeftKeyOrRightKey)), _
 "BOTH:   " & CStr(IsControlKeyDown(BothLeftAndRightKeys))

End Sub