SubClass Microsoft Access Form to Add Custom Navigation Buttons

Continuing on my previous article

 

Let us now explore taking the code we developed and create a Class Module we can use to subclass our forms with to greatly simplify our live!


 

Form SubClassing To Add Custom Nagiation To Any Form

Now the previous approach, using a form and putting all the code directly in it, is great, but you don’t want to have to add this code to every single form in which you wish to implement your custom navigation in!

What happens if you need to perform a change?!!!

So the best way to manage this is to create a Class Module and subclass your form(s). This way you can drop the Navigation buttons into any form and simply add 3-4 lines of code and have everything fully functional!

So how do we do that exactly?
 

The Class Module

Below is the complete code required for the Class Module. I named mine ‘Cls_Navigation’

Option Compare Database
Option Explicit

'Form
Private WithEvents oForm      As Access.Form
'Navigation
Private oLblRecNavHeader As Access.Label
Private oOptGrpRecNav         As Access.OptionGroup
'Private WithEvents oBtnRecNavDelete As Access.CommandButton
Private WithEvents oBtnRecNavNew As Access.CommandButton
Private WithEvents oBtnRecNavFirst As Access.CommandButton
Private WithEvents oBtnRecNavPrevious As Access.CommandButton
Private WithEvents oBtnRecNavNext As Access.CommandButton
Private WithEvents oBtnRecNavLast As Access.CommandButton
Private oTxtRecNavCounter As Access.TextBox

Const EventProcedure = "[Event Procedure]"


Public Property Set p_Form(ByRef oMyForm As Access.Form)
    Set oForm = oMyForm
End Property

Public Sub Class_init(ByRef oMyForm As Access.Form)
    Dim ctrl                  As Control
    Dim sCtrlSrc              As String
    Dim sFormat               As String
    Dim arrRGB                As Variant
    Dim lForeColor            As Long
    Dim iR As Integer, iG As Integer, iB As Integer
    Dim aRecNavBtns() As Variant
    Dim i As Byte
    'Const ColorScheme = "blue"
    'Const ColorScheme = "green"
    Const ColorScheme = "black"
    Const BackStyle_Normal = 1
    Const BackStyle_Transparent = 0
    Const BorderStyle_Transparent = 0
    Const BorderStyle_Solid = 1
    '    Const BorderStyle_Dashes = 2
    Const SpecialEffect_Flat = 0
    'Const PictureType_Embedded = 0
    Const PictureType_Linked = 1
    'Const PictureType_Shared = 2


    ' *******************************
    '           Form Module Variable Initializations
    ' **************************************************************
    'Form
    Set p_Form = oMyForm
    
    'Navigation
    Set oLblRecNavHeader = oForm.lbl_RecNav_Header
    Set oOptGrpRecNav = oForm.optGrp_RecNav
    'Set oBtnRecNavDelete = oForm.cmd_RecNav_Delete
    Set oBtnRecNavNew = oForm.cmd_RecNav_New
    Set oBtnRecNavFirst = oForm.cmd_RecNav_First
    Set oBtnRecNavPrevious = oForm.cmd_RecNav_Previous
    Set oBtnRecNavNext = oForm.cmd_RecNav_Next
    Set oBtnRecNavLast = oForm.cmd_RecNav_Last
    Set oTxtRecNavCounter = oForm.txt_RecNav_Counter


    ' *******************************
    '           Form Setup/Formatting
    ' **************************************************************
    oForm.NavigationButtons = False
    'Form Events
    oForm.OnCurrent = EventProcedure
    oForm.AfterUpdate = EventProcedure


    ' *******************************
    '           Navigation Setup/Formatting
    ' **************************************************************
    Call OLEtoRGB(oForm.Section(oLblRecNavHeader.Section).BackColor, iR, iG, iB)
    If iR + iG + iB > 330 Then
        'Light color
        lForeColor = vbBlack
    Else
        'Darker color
        lForeColor = vbWhite
    End If

    oLblRecNavHeader.BackColor = oForm.Section(oLblRecNavHeader.Section).BackColor
    oLblRecNavHeader.BackStyle = BackStyle_Normal
    oLblRecNavHeader.ForeColor = lForeColor
    oOptGrpRecNav.BorderStyle = BorderStyle_Solid
    oOptGrpRecNav.SpecialEffect = SpecialEffect_Flat    'Critical for the BorderWidth to work!
    oOptGrpRecNav.BorderWidth = 0    'under 3 and it doesn't work?!
    oOptGrpRecNav.BorderColor = lForeColor
    oOptGrpRecNav.BackColor = oForm.Section(oLblRecNavHeader.Section).BackColor
    oOptGrpRecNav.BackStyle = BackStyle_Normal
    oTxtRecNavCounter.BackStyle = BackStyle_Transparent
    oTxtRecNavCounter.ForeColor = lForeColor
    oTxtRecNavCounter.Enabled = False
    oTxtRecNavCounter.Locked = True

    With oBtnRecNavNew
        'oBtnRecNavDelete.Top = .Top
        oBtnRecNavFirst.Top = .Top
        oBtnRecNavPrevious.Top = .Top
        oBtnRecNavNext.Top = .Top
        oBtnRecNavLast.Top = .Top
    End With

    'Change the navigation button captions ...
    'aRecNavBtns = Array(oBtnRecNavDelete, oBtnRecNavNew, oBtnRecNavFirst, oBtnRecNavPrevious, oBtnRecNavNext, oBtnRecNavLast)
    aRecNavBtns = Array(oBtnRecNavNew, oBtnRecNavFirst, oBtnRecNavPrevious, oBtnRecNavNext, oBtnRecNavLast)
    'For i = 0 To 5
    For i = 0 To 4
        aRecNavBtns(i).OnClick = EventProcedure
        aRecNavBtns(i).BackStyle = BackStyle_Transparent
        aRecNavBtns(i).CursorOnHover = acCursorOnHoverHyperlinkHand
        aRecNavBtns(i).PictureType = PictureType_Linked 'To avoid bloating!
    Next
    'oBtnRecNavDelete.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\delete.png"
    'oBtnRecNavDelete.ControlTipText = "Delete the current record"
    oBtnRecNavNew.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\new.png"
    oBtnRecNavNew.ControlTipText = "Create a new record"
    oBtnRecNavFirst.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\first.png"
    oBtnRecNavFirst.ControlTipText = "Goto the 1st record"
    oBtnRecNavPrevious.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\previous.png"
    oBtnRecNavPrevious.ControlTipText = "Go back to the previous record"
    oBtnRecNavNext.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\next.png"
    oBtnRecNavNext.ControlTipText = "Go forward to the next record"
    oBtnRecNavLast.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\last.png"
    oBtnRecNavLast.ControlTipText = "Goto the last record"
End Sub

Private Sub Class_Terminate()
    Set oForm = Nothing
End Sub



' *******************************
'           Form Events
' **************************************************************
Private Sub oForm_AfterUpdate()
    Call SetupNav
End Sub

Private Sub oForm_Current()
    Call SetupNav
End Sub



' *******************************
'           Control Events
' **************************************************************
Private Sub oBtnRecNavDelete_Click()
    If MsgBox("Are you sure you want to delete this record?" & vbCrLf & _
              "This will permanently delete the record.", vbYesNo, "Delete Confirmation") = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunCommand acCmdDeleteRecord
        DoCmd.SetWarnings True
    End If
End Sub

Private Sub oBtnRecNavNew_Click()
    RunCommand acCmdRecordsGoToNew
End Sub

Private Sub oBtnRecNavPrevious_Click()
    RunCommand acCmdRecordsGoToPrevious
End Sub

Private Sub oBtnRecNavNext_Click()
    RunCommand acCmdRecordsGoToNext
End Sub

Private Sub oBtnRecNavLast_Click()
    RunCommand acCmdRecordsGoToLast
End Sub

Private Sub oBtnRecNavFirst_Click()
    RunCommand acCmdRecordsGoToFirst
End Sub



' *******************************
'           General Helper Procs
' **************************************************************
Public Sub SetupNav()
    Dim rs                    As DAO.Recordset
    Dim lCurrentRecord        As Long
    Dim lRecordCount          As Long
    
    lCurrentRecord = oForm.CurrentRecord
    Set rs = oForm.RecordsetClone
    rs.MoveLast
    lRecordCount = rs.RecordCount
    
    'Hide all the buttons
    'oBtnRecNavDelete.Enabled = False
    oBtnRecNavNew.Enabled = False
    oBtnRecNavFirst.Enabled = False
    oBtnRecNavPrevious.Enabled = False
    oBtnRecNavNext.Enabled = False
    oBtnRecNavLast.Enabled = False
    'Show button depending on the case
    If lCurrentRecord > lRecordCount Then
        'On a new entry
        If lRecordCount <> 0 Then
            'There are other records available (so not the 1st entry)
            oBtnRecNavFirst.Enabled = True
            oBtnRecNavPrevious.Enabled = True
            oBtnRecNavLast.Enabled = True
        End If
    ElseIf lCurrentRecord = lRecordCount Then
        'On the last available record
        'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
        oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
        If oForm.RecordsetClone.RecordCount > 1 Then
            oBtnRecNavFirst.Enabled = True
            oBtnRecNavPrevious.Enabled = True
        End If
    ElseIf lCurrentRecord = 1 And lRecordCount > 1 Then
        'On the 1st record and there are multiple records for the form
        'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
        oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
        oBtnRecNavNext.Enabled = True
        oBtnRecNavLast.Enabled = True
    Else
        'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
        oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
        oBtnRecNavFirst.Enabled = True
        oBtnRecNavPrevious.Enabled = True
        oBtnRecNavNext.Enabled = True
        oBtnRecNavLast.Enabled = True
    End If
    'Update record counter control
    oTxtRecNavCounter.ControlSource = "=""Record " & lCurrentRecord & " Of " & lRecordCount & """"
    
    Set rs = Nothing
End Sub

In the code you will notice several commented out lines relating to ‘oBtnRecNavDelete’, that is in case you wish to add a ‘Delete’ button to your Custom Navigation. this way the code is already available for you to exploit by simply uncommenting those lines.

Code Rundown

We start by declaring Module level variables representing the form and each of the navigation components.

Next we create a property to be able to set our module level form variable so we have to work with throughout the rest of our module.

Then, we build our initialization procedure that we call from our form to do all the setup. In it, we set all the variables. Assign ‘Event Procedure’ to the various required form events. After, I apply formatting to all the Navigation components, setting color, background styles, font colors, … Then, we assign ‘Event Procedure’ to each button so the to will run code when clicked. Lastly, I assign an image and Tip Text to each button.

We then create a Class Terminate event to perform any necessary cleanup when the class is terminated.

After that, we create the actual form events followed by each of the control events.

And to wrap things up, we create the Procedure called in the Form Events to update the button statuses and text displayed.

In the above example, I am populating each command button with an image by doing:

oBtnRecNavNew.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\new.png"

where I’ve create an ‘icons’ sub-directory with a series of theme sub-directories. As such, I can (or the user because it can be a user setting if so desired), switch the value of the ‘ColorScheme’ variable to instantaneously change the buttons used for the entire navigation system.
 

Form Code

Below is the required Form code to instantiate the Class to Sub Class the form.

Option Compare Database
Option Explicit

Private listener              As New Cls_Navigation


Private Sub Form_Close()
    Set listener = Nothing
End Sub

Private Sub Form_Open(Cancel As Integer)
    Call listener.Class_init(Me)
End Sub

As we’ve seen in my previous articles regarding sub classing, we only need to use the Open event to initialize the Class and then use the Close event to clean things up when we close the form, everything else is done via the Class Module.

Implementation

So now, once we have our Class Module in place, you need only copy over the various controls that comprise your navigation system and add the ‘Form Code’ to your form and you’re done! Now 7 lines of code provide you the full functionality that previously took hundreds of lines and you benefit from a single code base for updating things moving forward!

Per the usual, I’d highly encourage you to add proper error handling throughout the code. It is omitted here to keep the code simplified, but should always be included for production.
 

Demo Database

Feel free to download a 100% unlocked copy of the sample database (tested on Win10/Acc365 & Win10/Acc2013). This sample provides multiple variations to illustrate textual button, button using symbols or images. I provide both the standard implementation and the Sub Classing of forms.

Download “Custom Navigation Buttons” Form_SubClassing-Navigation.zip – Downloaded 7589 times – 257.40 KB

Notice About Content/Downloads/Demos

Disclaimer/Notes:

If you do not have Microsoft Access, simply download and install the freely available runtime version (this permits running MS Access databases, but not modifying their design):

Microsoft Access 2010 Runtime
Microsoft Access 2013 Runtime
Microsoft Access 2016 Runtime
Microsoft 365 Access Runtime

All code samples, download samples, links, ... on this site are provided 'AS IS'.

In no event will Devhut.net or CARDA Consultants Inc. be liable to the client/end-user or any third party for any damages, including any lost profits, lost savings or other incidental, consequential or special damages arising out of the operation of or inability to operate the software which CARDA Consultants Inc. has provided, even if CARDA Consultants Inc. has been advised of the possibility of such damages.

 

What Else Can We Do?

In my sample, I’m displaying images, but you can choose to display text or symbols instead. I chose to illustrate the most complex case for educational purposes.

Another great thing to do with Class Modules and such subclassing techniques is apply security routines and/or dynamic translations (if you are doing so at runtime).
 

Page History

Date Summary of Changes
2024-02-29 Initial Release