weArrowKeyNav Class

Do you want the up and down arrow keys to move to the previous and next records in a continuous Access form? Here's how to do that with only two lines of code.

weArrowKeyNav Class

A common problem in designing continuous forms in Access is what to do about the unintuitive behavior of the up and down arrow keys.

Instead of moving the focus of the cursor up and down visually within the form, the up and down arrow keys actually move the cursor left and right between the previous and next controls (instead of the previous and next records).

My Solution

To solve this problem, I created a class module that overrides the default behavior of the up and down arrow keys.  When this class is enabled on a form, pressing the up arrow moves the focus to the previous record while pressing the down arrow moves the focus to the next record.

Enabling this behavior on a form requires only two lines of code:

Option Explicit
Option Compare Database

Dim ArrowKeyNav As New weArrowKeyNav

Private Sub Form_Load()
	ArrowKeyNav.FullArrowKeyNav Me.Form
End Sub

The Code: weArrowKeyNav Class

The code below is simpler than it first appears.  Much of the code serves no purpose other than to detect the dropped-down state of a combo box control.

'---------------------------------------------------------------------------------------
' Module    : weArrowKeyNav
' Author    : Mike Wolfe (https://nolongerset.com/wearrowkeynav-class/)
' Date      : 9/14/2011 - 5/18/2021 20:51
' Purpose   : Subclass controls to provide Excel-style Up/Down arrow key navigation.
' Usage     : There are two ways to use this class.  The simple way, which enables
'               full arrow key navigation for all visible and enabled controls in the
'               detail section of a form, can be implemented with a single call.
'               The more explicit and flexible way is to enable the functionality on
'               a per-control basis.
'    Simple -
'           1. Add the following to the declaration section of the form module:
'               Dim ArrowKeyNav As New weArrowKeyNav
'           2. Add the following to the Form_Load/Form_Open event:
'               ArrowKeyNav.FullArrowKeyNav Me.Form
'  Explicit - This example assumes a form with a TextBox named ItemAmt,
'               a ComboBox named AcctPicker, and a CheckBox named IncOn1099
'           1. Add the following to the declaration section of the form module:
'               Dim weAcctPicker As New weArrowKeyNav
'               Dim weItemAmt As New weArrowKeyNav
'               Dim weIncOn1099 As New weArrowKeyNav
'           2. Add the following to the Form_Load/Form_Open event:
'               Private Sub Form_Load()
'                   'Set the appropriate controls as instances of the class
'                   Set weAcctPicker.Control = Me.AcctPicker
'                   Set weItemAmt.Control = Me.ItemAmt
'                   Set weIncOn1099.Control = Me.IncOn1099
'               End Sub
'---------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

Private WithEvents weTextBox As TextBox
Private WithEvents weComboBox As ComboBox
Private WithEvents weCheckBox As CheckBox

Private CtlColl As Collection

'retrieved on 10/11/2011 @ 11:31 from: http://access.mvps.org/access/api/api0052.htm
'******* Code Start *********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
'  retrieves the name of the class to which the specified window belongs.
#If VBA7 Then
    Private Declare PtrSafe Function apiGetClassName Lib "user32" _
        Alias "GetClassNameA" _
        (ByVal hWnd As LongPtr, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long
#Else
    Private Declare Function apiGetClassName Lib "user32" _
        Alias "GetClassNameA" _
        (ByVal hWnd As Long, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) _
        As Long
#End If

'  retrieves a handle to the specified child window's parent window.
#If VBA7 Then
    Private Declare PtrSafe Function apiGetParent Lib "user32" _
        Alias "GetParent" _
        (ByVal hWnd As LongPtr) _
        As LongPtr
#Else
    Private Declare Function apiGetParent Lib "user32" _
        Alias "GetParent" _
        (ByVal hWnd As Long) _
        As Long
#End If

'  retrieves information about the specified window. The function also
'  retrieves the 32-bit (long) value at the specified offset into the
'  extra window memory of a window.
#If Win64 Then
    Private Declare PtrSafe Function apiGetWindowLong Lib "user32" _
            Alias "GetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
            ByVal nIndex As Long) _
            As LongPtr
#Else
    #If VBA7 Then
        Private Declare PtrSafe Function apiGetWindowLong Lib "user32" _
            Alias "GetWindowLongA" _
            (ByVal hWnd As LongPtr, _
            ByVal nIndex As Long) _
            As Long
    #Else
        Private Declare Function apiGetWindowLong Lib "user32" _
            Alias "GetWindowLongA" _
            (ByVal hWnd As Long, _
            ByVal nIndex As Long) _
            As Long
    #End If
#End If

'  retrieves a handle to the top-level window whose class name and
'  window name match the specified strings. This function does not search
'  child windows. This function does not perform a case-sensitive search.
#If VBA7 Then
    Private Declare PtrSafe Function apiFindWindow Lib "user32" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
        As LongPtr
#Else
    Private Declare Function apiFindWindow Lib "user32" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
        As Long
#End If

'  retrieves a handle to a window that has the specified relationship
'  (Z order or owner) to the specified window
#If VBA7 Then
    Private Declare PtrSafe Function apiGetWindow Lib "user32" _
        Alias "GetWindow" _
        (ByVal hWnd As LongPtr, _
        ByVal wCmd As Long) _
        As LongPtr
#Else
    Private Declare Function apiGetWindow Lib "user32" _
        Alias "GetWindow" _
        (ByVal hWnd As Long, _
        ByVal wCmd As Long) _
        As Long
#End If

'  The class name for an Access combo's drop down listbox window
Private Const ACC_CBX_LISTBOX_CLASS = "OGrid"
'  Class name for the Access window
Private Const ACC_MAIN_CLASS = "OMain"
'  Class name for an Access combo's drop down listbox's parent window
Private Const ACC_CBX_LISTBOX_PARENT_CLASS = "ODCombo"
'  class name for an Access form's client window
Private Const ACC_FORM_CLIENT_CLASS = "OFormSub"
'  class name for Edit controls in Access
Private Const ACC_CBX_EDIT_CLASS = "OKttbx"
'  class name for VB combo's drop down listbox's parent window (SDI)
Private Const VB_CBX_LISTBOX_PARENT_CLASS = "#32769" ' // Desktop
'  class name for VB combo's drop down listbox window
Private Const VB_CBX_LISTBOX_CLASS = "ComboLBox"
'  handle identifies the child window at the top of the Z order,
'  if the specified window is a parent window
Private Const GW_CHILD = 5
'  Retrieves the window styles.
Private Const GWL_STYLE = (-16)
'  flag denoting that a window is visible
Private Const WS_VISIBLE = &H10000000

Private Function fIsComboOpen() As Boolean
'  returns true if a combo box on the form is dropped down
'  only one combo can have the focus => only one drop down
'
Static hWnd As Variant  ' Long/LongPtr
Static hWndCBX_LBX As Variant  ' Long/LongPtr

   hWnd = 0: hWndCBX_LBX = 0

   '  Start with finding the window with "ODCombo" class name
   hWnd = apiFindWindow(ACC_CBX_LISTBOX_PARENT_CLASS, _
                                vbNullString)
   '  Parent window of ODCombo is the Access window
   If apiGetParent(hWnd) = hWndAccessApp Then
         '  Child window of ODCombo window is the
         '  drop down listbox associated with a combobox
         hWndCBX_LBX = apiGetWindow(hWnd, GW_CHILD)
         '  another check to confirm that we're looking at the right window
         If fGetClassName(hWndCBX_LBX) = _
                        ACC_CBX_LISTBOX_CLASS Then
            '  Finally, if this window is visible,
            If apiGetWindowLong(hWnd, GWL_STYLE) And WS_VISIBLE Then
               '  the Combo must be open
               fIsComboOpen = True
            End If
         End If
      End If
End Function

Private Function fGetClassName(hWnd As Variant)  ' Long/LongPtr)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
    strBuffer = Space$(MAX_LEN)
    lngLen = apiGetClassName(hWnd, strBuffer, MAX_LEN)
    If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
'******* Code End *********

Public Sub FullArrowKeyNav(Frm As Form)
    Dim Ctl As Control
    Set CtlColl = New Collection
    For Each Ctl In Frm.Section(acDetail).Controls
        Select Case Ctl.ControlType
        Case acTextBox, acComboBox, acCheckBox
            If Ctl.Enabled And Ctl.Visible Then
                Dim NavCtl As weArrowKeyNav
                Set NavCtl = New weArrowKeyNav
                Set NavCtl.Control = Ctl
                CtlColl.Add NavCtl
            End If
        End Select
    Next Ctl
End Sub

Public Property Set Control(ByVal Ctl As Control)
    Select Case Ctl.ControlType
    Case acTextBox
        Set weTextBox = Ctl
        weTextBox.OnKeyDown = "[Event Procedure]"
    Case acComboBox
        Set weComboBox = Ctl
        weComboBox.OnKeyDown = "[Event Procedure]"
    Case acCheckBox
        Set weCheckBox = Ctl
        weCheckBox.OnKeyDown = "[Event Procedure]"
    End Select
End Property

Private Sub Class_Terminate()
    On Error Resume Next
    If Not CtlColl Is Nothing Then
        Dim Ctl As Object
        For Each Ctl In CtlColl
            Set Ctl = Nothing
        Next Ctl
        Set CtlColl = Nothing
    End If
End Sub

Private Sub weCheckBox_KeyDown(KeyCode As Integer, Shift As Integer)
    KeyCode = KeyDown(weCheckBox, KeyCode, Shift)
End Sub

Private Sub weComboBox_KeyDown(KeyCode As Integer, Shift As Integer)
    If fIsComboOpen() Then Exit Sub
    
    KeyCode = KeyDown(weComboBox, KeyCode, Shift)
End Sub

Private Sub weTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
    KeyCode = KeyDown(weTextBox, KeyCode, Shift)
End Sub

Private Function KeyDown(Ctl As Control, KeyCode As Integer, Shift As Integer) As Integer
Dim rs As Object ' DAO.Recordset or ADODB.Recordset
    On Error GoTo Err_KeyDown

    Dim Frm As Form
    Set Frm = GetFormFromCtl(Ctl)

    KeyDown = 0
    Set rs = Frm.Recordset
    Select Case KeyCode
    Case vbKeyDown
        If Not rs.EOF Then
            rs.MoveNext
            If rs.EOF Then
                If Frm.AllowAdditions Then
                    'Every call to rs.AddNew increments the AutoNumber,
                    '   even if we don't edit the new record;
                    'Setting Frm.SelTop avoids this problem
                    Frm.SelTop = rs.RecordCount + 1
                Else
                    rs.MovePrevious
                End If
            End If
            Ctl.SetFocus
        ElseIf Frm.AllowAdditions Then
            Frm.SelTop = rs.RecordCount + 1
        End If
    Case vbKeyUp
        If Not rs.BOF Then
            If Frm.NewRecord Then
                rs.MoveLast
            Else
                rs.MovePrevious
                If rs.BOF Then rs.MoveNext
            End If
            Ctl.SetFocus
        End If
    Case Else
        KeyDown = KeyCode
    End Select

Exit_KeyDown:
    Exit Function
Err_KeyDown:
    Select Case Err.Number
    Case 3420
        'Object invalid or no longer set
        '   This can happen if we make changes to the underlying recordset in the form's AfterUpdate event
    Case 3426
        'This action was cancelled by an associated object. 
        '   Don't log this error; just allow it to pass silently through.
        '   This is the error generated when user tries to move to a different record and
        '   can't because of a missing required field or some other failed validation.
    Case Else
        MsgBox Err.Description, vbExclamation, "Error " & Err.Number
    End Select
    Resume Exit_KeyDown
    Resume
End Function


Private Function GetFormFromCtl(Ctl As Control) As Form
    If TypeOf Ctl.Parent Is Form Then
        Set GetFormFromCtl = Ctl.Parent
    Else
        'Recursively call the function passing the current control's
        '   parent until eventually we arrive at the form
        Set GetFormFromCtl = GetFormFromCtl(Ctl.Parent)
    End If
End Function

A short note about the "we" prefix

I use semantic prefixes with my code modules to help organize them within the VBA editor.  The "we" portion of weArrowKeyNav conveys that the class relies heavily on the WithEvents keyword to provide its functionality.

Image by GuHyeok Jeong from Pixabay

Comments

Sign in or become a No Longer Set member to join the conversation.
Just enter your email below to get a log in link. (This will also subscribe you to my weekly newsletter.)