Option Explicit
'Declare the module-global tab-order control constants and variables
'NOTE: See the MoveFocus routine's header commentary for specifics about how the tab-sequence is managed in
'this implementation.
Private Const fmShiftMask As Integer = 1 'SHIFT was pressed.
Private Const fmCtrlMask As Integer = 2 'CTRL was pressed.
Private Const fmAltMask As Integer = 4 'ALT was pressed.
Private Const ASCII_Enter As Integer = 13
Private Const ASCII_Tab As Integer = 9
'To change the Tab order of managed controls, just edit the following list:
Private Const TabOrderDef As String = _
"CommandButton1," & _
"TextBox1," & _
"CommandButton2" 'Module-global so that all controls on this sheet can access it
'NOTE: See the MoveFocus routine's header commentary regarding (re)initialization of the following variables:
Private TabOrderNames As Variant 'Module-global so that all controls on this sheet can access it
Private TabOrderCntrls() As OLEObject ' "
Private Const ChkBoxType As String = "CheckBox"
Private Const CmdBtnType As String = "CommandButton"
Private Const OptBtnType As String = "OptionButton"
Private Const TxtBoxType As String = "TextBox"
'=================================================================================================================
' ActiveX/OLE Control Event Handlers
'=================================================================================================================
Private Sub CommandButton1_Click()
MsgBox "CommandButton1 was clicked"
End Sub
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'NOTE: Use the KeyDown (or KeyUp) event because it is triggered for action keys like Enter and Tab, and also
'because it provides the Shift/Ctrl/Alt key status.
Dim ThisCntrl As Object
Set ThisCntrl = Me.CommandButton1 'IMPORTANT: Must be customized to be this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
Call DoActionKey(KeyCode, ThisCntrl, TabIdx, Shift)
End Sub
Private Sub CommandButton2_Click()
MsgBox "CommandButton2 was clicked"
End Sub
Private Sub CommandButton2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'NOTE: Use the KeyDown (or KeyUp) event because it is triggered for action keys like Enter and Tab, and also
'because it provides the Shift/Ctrl/Alt key status.
Dim ThisCntrl As Object
Set ThisCntrl = Me.CommandButton2 'IMPORTANT: Must be customized to be this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
Call DoActionKey(KeyCode, ThisCntrl, TabIdx, Shift)
End Sub
Private Sub TextBox1_LostFocus()
If TextBox1.Value <> vbNullString Then MsgBox "TextBox1 contains: '" & TextBox1.Value & "'"
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'NOTE: Use the KeyDown (or KeyUp) event because it is triggered for action keys like Enter and Tab, and also
'because it provides the Shift/Ctrl/Alt key status.
Dim ThisCntrl As Object
Set ThisCntrl = Me.TextBox1 'IMPORTANT: Must be customized to be this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
Call DoActionKey(KeyCode, ThisCntrl, TabIdx, Shift)
End Sub
'=================================================================================================================
' Module Subroutines and Functions
'=================================================================================================================
Sub DoActionKey(KeyCode As MSForms.ReturnInteger, Cntrl As Object, ByRef TabIndex As Integer, Shift As Integer)
'
'Checks whether the specified key code is an action key (e.g. Enter or Tab) and, if so, initiates the
'appropriate action, depending on the type of the specified control and, possibly, its property settings.
'
'In this implementation:
'
' * Tab key: regardless of the control's type, the focus is moved to the previous or next control in the
' globally defined tab-sequence order, depending on whether the Shift key was also pressed or not. See
' the MoveFocus routine's header commentary for specifics about how the tab-sequence is managed in this
' implementation.
'
' * Enter key:
' + If the control is a commmand button, then that button's Click event handler is called to simulate a
' button click.
'
' + If the control is a text box:
' - If it is a single-line text box or its new-line Enter key behavior is disabled, then the Enter
' key press is treated like an un-shifted Tab key and focus is moved forward to the next control
' in the globally defined tab-sequence order.
'
' - If it is a multi-line text box and its new-line Enter key behavior is enabled, then the Enter
' key press remains unprocessed by this routine and is thereby allowed to function as a new-line
' operation in the multi-line text box.
'
'NOTE: This routine may need to be customized for a different implementation.
'
'PARAMETERS:
'
' KeyCode The key code to be checked for being an action-key code.
'
' Cntrl The ActiveX/OLE control object from which the key code was generated due to its having focus
' at the time of the user key-press.
'
' TabIndex The tab-index value of the control that generated the key code. See the MoveFocus routine's
' header commentary regarding (re)initialization of thie (ByRef) parameter.
'
' Shift The state of the Shift, Ctrl, and Alt keys at the time of the user's key press action. Is a
' bit array defined by the constants fmShiftMask, fmCtrlMask, and fmAltMask.
'
'*************************************************************************************************************
Select Case KeyCode
Case ASCII_Tab
Dim Backward As Boolean
Backward = (Shift And fmShiftMask) 'Bit-wise "And" converted to Boolean value
Call MoveFocus(Cntrl:=Cntrl, TabIndex:=TabIndex, Backward:=Backward)
Case ASCII_Enter
Select Case TypeName(Cntrl)
Case TxtBoxType
If Not (Cntrl.EnterKeyBehavior And Cntrl.MultiLine) Then
'The Textbox either isn't multi-line or its new-line Enter key behavior is disabled, so
'treat the enter key like a Tab key and move to the next control in the tab-order.
Call MoveFocus(Cntrl:=Cntrl, TabIndex:=TabIndex)
End If
Case Else 'CmdBtnType (is the only alternative in this implementation)
'This control is a command button, so treat an Enter key press like a click event.
On Error Resume Next 'In case the specified command button has no Click event handler defined
Application.Run Me.CodeName & "." & Cntrl.Name & "_Click"
On Error GoTo 0
End Select
End Select
End Sub
Sub MoveFocus(Cntrl As Object, ByRef TabIndex As Integer, Optional Backward As Boolean)
'
'Moves the focus to the next or previous ActiveX/OLE control listed in the (global) TabOrderCntrls list,
'depending on whether the Backward paramater is False (default) or set to True by the calling code. The
'next/previous control is determined relative to the specified tab-index value, which defines the calling
'control's position in the TabOrderCntrls list.
'
'PARAMETERS:
'
' Cntrl The ActiveX/OLE control object from which the focus is to be moved.
'
' TabIndex The tab-index value of the control from which the focus is to be moved. If uninitialized
' (value = 0) then it is (re)initialized by searching the (global) TabOrderNames array for
' the specified control-name and sets this (ByRef) parameter, and thereby the calling event
' handler's corresponding variable argument, to be its found position in that array.
'
' Backward If set to True, the focus is moved backward. If False (default) then the focus is moved
' forward.
'
'NOTE: If necessary, the global arrays TabOrderNames and TabOrderCntrls are (re)initialized before processing
' the move-focus event, using the root-definition of the tab order defined by the (global) control-name
' list, TabOrderDef.
'
'*************************************************************************************************************
Dim i As Integer 'Reusable loop counter
'Check whether all variables are initialized
If IsEmpty(TabOrderNames) Then
'The (global) tab order control-names list is uninitialized, so initialize it using the TabOrderDef list
'of the constrols to be included in move-focus control system.
TabOrderNames = Split(TabOrderDef, ",")
ReDim Preserve TabOrderNames(1 To UBound(TabOrderNames) + 1) 'Convert from zero-based to one-based array
If Not IsInitArray(TabOrderCntrls) Then
'The (global) tab order control-objects list is also uninitialized, so initialize it.
ReDim TabOrderCntrls(1 To UBound(TabOrderNames)) 'First, allocate the necessary number of entries
'Check whether each ActiveX/OLE control on the specified control's parent worksheet is included in the
'tab order control-names list and, if so, add them to the tab order control-objects list in the same
'position as in the tab order control-names list.
Dim ChkCntrl As OLEObject
Dim WkSh As Worksheet
Set WkSh = Cntrl.Parent
For Each ChkCntrl In WkSh.OLEObjects
'Search for this next worksheet control in the tab order control-names list
For i = LBound(TabOrderNames) To UBound(TabOrderNames)
If TabOrderNames(i) = ChkCntrl.Name Then Exit For 'If found, exit search loop
Next i
If i <= UBound(TabOrderNames) Then
'This control is on the tab order list, so add it to the tab order control-object list in the
'corresponding position.
Set TabOrderCntrls(i) = ChkCntrl
End If
Next ChkCntrl
End If
End If
If TabIndex = 0 Then
'The calling control's tab index value is uninitialized, so initialize it by finding the control name's
'position in the tab order control-names list.
Dim CntrlName As String
CntrlName = Cntrl.Name
For i = LBound(TabOrderNames) To UBound(TabOrderNames)
If TabOrderNames(i) = CntrlName Then Exit For 'If found, exit search loop
Next i
If i > UBound(TabOrderNames) Then
'Didn't find it, so display an explanatory error message and then abort
Call MsgBox("The ActiveX control '" & CntrlName & _
"' was not found in the 'TabOrderDef' control list.", _
vbOKOnly + vbCritical, "PROGRAMMING ERROR")
Exit Sub
End If
TabIndex = i 'Found it
End If
'Do the move-focus operation
If Backward Then
If TabIndex > LBound(TabOrderCntrls) Then
TabOrderCntrls(TabIndex - 1).Activate 'Move to the previous control in the list
Else
TabOrderCntrls(UBound(TabOrderCntrls)).Activate 'Wrap-around to the last control in the list
End If
Else
If TabIndex < UBound(TabOrderCntrls) Then
TabOrderCntrls(TabIndex + 1).Activate 'Move to the next control in the list
Else
TabOrderCntrls(LBound(TabOrderCntrls)).Activate 'Wrap-around to the first control in the list
End If
End If
End Sub
Public Function IsInitArray(CheckArray) As Boolean
'Returns True if the specified array argument is an initialized array, False otherwise. If the specified
'argument is not an array variable, then False is returned so that the programmer will discover the
'misapplication of this function as a result of unexpected behavior of the algorithm in which it is used.
Dim UB As Long
On Error Resume Next
UB = UBound(CheckArray)
IsInitArray = (UB > -1 And Err = 0) 'NOTE: must check value of UB, as described below*
On Error GoTo 0
' * because Split() has a "bug" that can result in an uninitialized array for which UBound returns -1
' without throwing an error. e.g. Split(vbNullString, ","). I put "bug" in quotes because that is how
' Ubound() should always work on an uninitialized array but, unfortunately, it doesn't, except as a
' result of the Split() anomaly.
End Function
