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 AtlTabKeyCode As Integer = 18 'Sometimes used by programmers to swap windows when debugging
'To change the Tab order of managed controls, just edit the following list:
Private Const TabOrderDef As String = _
"CommandButton1," & _
"TextBox1," & _
"CommandButton2" 'Is 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 'Is 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: Uses 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: Customize to refer to this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
If KeyCode = AtlTabKeyCode Then Exit Sub 'Sometimes used by programmers to swap windows when debugging
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: Uses 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: Customize to refer to this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
If KeyCode = AtlTabKeyCode Then Exit Sub 'Sometimes used by programmers to swap windows when debugging
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: Uses 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: Customize to refer to this event handler's parent control!
Static TabIdx As Integer 'Static so its value is persistent, but is local to this event handler
If KeyCode = AtlTabKeyCode Then Exit Sub 'Sometimes used by programmers to swap windows when debugging
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 (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 this (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 vbKeyTab
Dim Backward As Boolean
Backward = (Shift And fmShiftMask) 'Bit-wise "And" converted to Boolean value
Call MoveFocus(Cntrl, TabIndex, Backward)
Case vbKeyReturn
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, TabIndex)
End If
Case CmdBtnType
'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
Case Else
Stop 'CUSTOMIZE: Add additional cases above, for other control types, for your implementation.
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 ChkAXObj As Object
Dim i As Integer
Dim NextCntrl As Object
Dim TabOrderCount As Integer
'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 controls 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 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 (unless it is a command button with its TakeFocus******* property
'disabled).
Set ChkAXObj = ChkCntrl.Object 'Get the actual ActiveX control from its OLE-object wrapper
If TypeName(ChkAXObj) = CmdBtnType Then
'Is a command-button control, which has a TakeFocus******* property, so check whether it
'is set to allow this control to actually take the focus and, if so, add it to the tab
'order control-object list.
If ChkAXObj.TakeFocus******* Then
Set TabOrderCntrls(i) = ChkCntrl
TabOrderCount = TabOrderCount + 1
End If
Else 'No other control types have a TakeFocus******* property, so no need to check them
Set TabOrderCntrls(i) = ChkCntrl
TabOrderCount = TabOrderCount + 1
End If
End If
Next ChkCntrl
If TabOrderCount < UBound(TabOrderCntrls) Then
'Some of the controls in the tab order control-names list were not actually added (i.e. command
'buttons with their TakeFocus******* property diabled), so resize the resulting tab order
'control-object list accordingly.
ReDim Preserve TabOrderCntrls(LBound(TabOrderCntrls) To TabOrderCount)
End If
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 any special processing (e.g. formatting a Textbox date string to be a standard date format) prior to
'actually moving the focus to a different control
'
'...
'
'Do the move-focus operation by incrementing to the next/previous tab index
i = TabIndex + IIf(Backward, -1, 1)
'But adjust for possible tab order control-object list wrap-around conditions
If Backward Then
If i < LBound(TabOrderCntrls) Then i = UBound(TabOrderCntrls) 'Past start of list, so wrap to end of list
Else
If i > UBound(TabOrderCntrls) Then i = LBound(TabOrderCntrls) 'Past end of list, so wrap to start of list
End If
Set NextCntrl = TabOrderCntrls(i)
If Not NextCntrl Is Nothing Then NextCntrl.Activate 'Move the focus
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
