LEARN MS-ACCESS TIPS AND TRICKS

Group-Wise Ranking Using Class Module

2026-03-02T21:42:00.003+05:30

Group-Wise Ranking in Microsoft Access Using a Class Module

A Reusable Object-Oriented Approach.

In earlier articles, we explored how to prepare a Rank List in Microsoft Access using procedural VBA. While that method works reliably, modern Access application design benefits greatly from encapsulating business logic inside Class Modules.

Unlike database engines such as Microsoft SQL Server, which provide built-in ranking functions like RANK() and ROW_NUMBER(), Microsoft Access does not natively support group-wise ranking in SQL.

This article demonstrates how to implement ranking logic using a dedicated class module, making the solution:

Reusable
Maintainable
Extensible
Compatible with local and linked tables

Why Use a Class Module?

Moving ranking logic into a class provides:

✔ Encapsulation of ranking behavior.

✔ Reusability across forms, reports, and automation tasks.

✔ Cleaner separation of concerns.

✔ Easier debugging and future enhancement.

This design is especially useful in structured Access applications that follow modular architecture principles.

Design Overview

The class will:

Accept a source table or query.
Accept grouping and sorting fields.
Accept ranking style (Dense / Competition / Sequential).
Execute ranking.
Update a designated Rank field.

Step 1: Create the Class Module.

Create a new Class Module and name it:

clsRankList

Step 2: Insert the Following Code.

Option Compare Database

Option Explicit


Private mSource As String

Private mGroupField As String

Private mValueField As String

Private mRankField As String

Private mRankingType As String


Public Property Let SourceTable(ByVal vValue As String)

    mSource = vValue

End Property


Public Property Let GroupField(ByVal vValue As String)

    mGroupField = vValue

End Property


Public Property Let ValueField(ByVal vValue As String)

    mValueField = vValue

End Property


Public Property Let RankField(ByVal vValue As String)

    mRankField = vValue

End Property


Public Property Let RankingType(ByVal vValue As String)

    mRankingType = UCase(vValue)

End Property


Public Sub ExecuteRanking()

    Dim db As DAO.Database

    Dim rs As DAO.Recordset

    Dim strSQL As String


    Dim CurrentGroup As Variant

    Dim PreviousValue As Variant

    Dim RankNo As Long

    Dim SkipCount As Long


    If mRankingType = "" Then mRankingType = "DENSE"

    Set db = CurrentDb


    strSQL = "SELECT * FROM [" & mSource & "] " & _

             "ORDER BY [" & mGroupField & "], [" & mValueField & "] DESC;"


    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

    If rs.EOF Then Exit Sub

    rs.MoveFirst

    CurrentGroup = Null

    PreviousValue = Null

    RankNo = 0

    SkipCount = 0

    Do While Not rs.EOF        

        If Nz(rs(mGroupField)) <> Nz(CurrentGroup) Then        

            CurrentGroup = rs(mGroupField)

            RankNo = 1

            SkipCount = 1

            PreviousValue = rs(mValueField)           

        Else            

            Select Case mRankingType

                Case "DENSE"

                    If rs(mValueField) <> PreviousValue Then

                        RankNo = RankNo + 1

                    End If            

                Case "COMPETITION"

                    If rs(mValueField) <> PreviousValue Then

                        RankNo = SkipCount

                    End If               

                Case "SEQUENTIAL"

                    RankNo = RankNo + 1                 

            End Select            

            SkipCount = SkipCount + 1

            PreviousValue = rs(mValueField)

        End If        

        rs.Edit

        rs(mRankField) = RankNo

        rs.Update       

        rs.MoveNext        

    Loop

    rs.Close

    Set rs = Nothing
    Set db = Nothing   

End Sub

Step 3: Using the Class

From a standard module, form, or automation routine:

Dim objRank As New clsRankList

With objRank

    .SourceTable = "tblStudentMarks"

    .GroupField = "Class"

    .ValueField = "TotalMarks"

    .RankField = "Rank"

    .RankingType = "COMPETITION"

    .ExecuteRanking

End With

Set objRank = Nothing

Supported Ranking Types

RankingType Behavior

DENSE 1, 2, 2, 3

COMPETITION 1, 2, 2, 4

SEQUENTIAL 1, 2, 3, 4

If no ranking type is specified, DENSE is used by default.

Advantages of This Approach.

Clean Object-Oriented Design

Encapsulates ranking behavior into a single reusable object.
Compatible with Linked Tables

Uses dbOpenDynaset, so it works with ODBC sources.
Extensible

Future enhancements may include:
- Multiple group levels
- Dynamic ORDER BY clauses
  
  Returning ranked recordsets instead of updating tables
  
  Error handling classes
Integration-Friendly

Works well with form wrappers and structured automation routines.

Performance Notes

Efficient for moderate datasets.
Ensure indexes exist on GroupField and ValueField.
For very large datasets, consider server-side ranking.

Final Thoughts

Encapsulating ranking logic inside a class module elevates the solution from a procedural workaround to a structured, reusable component.

For developers who build modular Microsoft Access applications, this approach promotes:

Clean architecture
Reusability
Maintainability
Professional-grade design

--oOo--

Wrapper Class Template Wizard V2

2024-06-29T12:10:00.014+05:30

Streamlining Form Module Code in Standalone Class Module.

Class Module Template Creation Wizard V2.

The earlier version of the Class Module Wizard was a testing platform for creating Wrapper Class Module templates. Although it served its purpose, the procedure adopted there is somewhat semi-automatic, and I am not satisfied with that either.

This improved Version 2.0 of the Wizard can create several Class Module Templates for different Object Types in your form. This Version creates approximately 10 frequently used Object Wrapper Class Module Templates based on your selection at a time.

The Screenshot of the Class Template Wizard is given below:

Right-click to open Large Image in New Tab/Window.

The ListBox's Source Data is from the 'ListItems' Table. The Source Table Image is given below.

Right-click to open Large Image in New Tab/Window.

The Table has ten Records with six columns of data, but only the first three columns are shown on the ListBox.

(1) The RecordID - for easier retrieval of Wizard Function Parameters.
(2) The Field/Control list File Name for creating on Disk - The files will be created in the Current Project Folder.
(3) The Class Module Template Name - suffixed with the word '_Template' is preferred, not mandatory.

The following three Columns of data are used by the Wizard.

(4) The Wizard Function that creates the Class Template - Applicable for all Types of Objects.
(5) The Object TypeName - self-explanatory.
(6) Object Short Name - you may change it to a more descriptive Name if required.

How to Run the WrapperClassWizard from within a Database?

Place the WrapperClass_Wizard.accdb database into a Trusted Folder.

Open your Database and open the VBE Window.

Select References... from the Tools menu, find the Wizard Database, attach, and select to add it to the selected List of Library Files.

Create a SELECT Query in your Project with the name ListItemsQ using the following SQL:

SELECT ListItems.*
FROM ListItems IN 'D:\DEMO\Code2\WrapperClass_Wizard.accdb';

Change the Folder Path to the location of the WrapperClass_Wizard.accdb correctly.

You can create class module templates with the main object declarations (e.g., TextBox and Form, or any other Control and Form) with their property procedures for up to 10 of the most frequently used controls on the form.

Additionally, you can add a sample Click Event Subroutine Code foundation with all the Data Field Names (eg, TextBox and ComboBox Names) collected from the Form. To achieve this, insert a few lines of code (shown in red) in the Class_Init() Subroutine listing below, to collect each Control Type in separate Groups from the Form and save them into their designated text files on disk when the Form is in open state.

Note: If you plan to implement this Data Field Name saving procedure for two or more forms, the contents of this text file on Disk will be overwritten with the last open Form's Field Names.

For creating the TextBox or ComboBox sample Click Event Subroutine for a particular Form, open the Form with its Class_Init() Subroutine Code Lines in red, for a few seconds, and close it before running the Class Template creation Wizard.

I recommend this procedure to collect the Data field names on the Form using Code, because all of them are inserted from the data source Table/Query. Memorizing all their names correctly for easier event subroutine coding is impractical.

The code lines (marked in Red) are inserted into the Class_Init() subroutine to write out the Category-wise Field Names into their respective Files on Disk. All TextBox Field Names in one Text File, ComboBox Field Names in another, and so on. Below that is the Class_Init() Subroutine in the Class_ObjInit Class Module of the Employees Form, implemented with this procedure.

Option Compare Database
Option Explicit

Private txt As Data_TxtBox
Private Cbo As Data_CboBox
Private cmd As Data_CmdButton

Private Coll As New Collection
Private Frm As Form

'--------------------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'With Reusable Code
'--------------------------------------------------------------------
'The 'WrapperClassWizard.accdb' attached to this Database
'Check: Tools--> References...
'--------------------------------------------------------------------
'1. The 'Class_ObjInit' Class saves TxtBox/Field Names, Command Button,
'ComboBox Names, and others from the Open Form into TextBoxFields.txt,
'CmdButtonList.txt & ComboBoxList.txt files in the same Database Folder.
'
'2. The 'WrapperClassWizard.accdb' must be attached to the
'Current Project to open up the Wizard Form by running
'the Function: OpenClassWizard() from within a Command button Click.
'
'3. The Wizard Reads the Field Names from tbe above Text Files.
'
'4. The Wizard will use the Field/Control Names(if any) for the sample
'Event Subroutine in the Template. If the file is empty then it will
'create a sample Evet Subroutine without the Control names.
'
'5. This saves Coding time otherwise spent on creating a
'New Wrapper Class Module from scratch and picking the
'Field Names and other Control Names correctly
'From the Form for Event Subroutines.
'--------------------------------------------------------------------
'Author:  a.p.r. pillai
'Date  :  20/06/2024
'Remarks: with Ready-made Data Entry Events Handler
'       : in the Wrapper TextBox Class Module
'       : Suitable for Columnar, Tabular or DataSheet Form
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'--------------------------------------------------------------------

Public Property Get o_Frm() As Form
    Set o_Frm = Frm
End Property

Public Property Set o_Frm(ByRef vFrm As Form)
    Set Frm = vFrm

    Class_Init
End Property

Private Sub Class_Init()
Dim ProjectPath As String
Dim txtPath As String
Dim ComboPath As String
Dim FieldListFile As String
Dim ComboBoxList As String
Dim ctl As Control

On Error GoTo ClassInit_Err

Const EP = "[Event Procedure]"

'Save TextBox & CombBox Names into separate Text Files
'for creating Event Subroutines in the Templates
ProjectPath = CurrentProject.Path & "\"

FieldListFile = DLookup("FieldListFile", "ListItemsQ", "ID = " & wizTextBox)
ComboBoxList = DLookup("FieldListFile", "ListItemsQ", "ID = " & wizComboBox)

txtPath = ProjectPath & FieldListFile
ComboPath = ProjectPath & ComboBoxList

Open txtPath For Output As #1 'TextBoxFields.txt for writing
Open ComboPath For Output As #2 'ComboBoxList.txt

'Instantiate the 'Data_txtBox' Class for each TextBox
'on the Form for streamlined Event Procedures Coding
For Each ctl In Frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
    Print #1, ctl.Name 'write Field/TextBox Name in TextBoxFields.txt File
            Set txt = New Data_TxtBox
            Set txt.m_Frm = Frm
            Set txt.m_txt = ctl
            
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                txt.m_txt.BackColor = 62207 'yellow
                txt.m_txt.BackStyle = 0
    
                txt.m_txt.BeforeUpdate = EP
                txt.m_txt.OnDirty = EP
                
                Coll.Add txt 'Add Data_TxtBox Class Instance to Collection
                Set txt = Nothing 'Reset txt object
      
      Case "CommandButton"
           Set cmd = New Data_CmdButton
            Set cmd.Obj_Form = Frm
            Set cmd.cmd_Button = ctl
                
                cmd.cmd_Button.OnClick = EP
                
                Coll.Add cmd
                Set cmd = Nothing
                
      Case "ComboBox"
    Print #2, ctl.Name 'write ComboBox Names in ComboBoxList.txt File
            Set Cbo = New Data_CboBox
            Set Cbo.m_Frm = Frm
            Set Cbo.m_Cbo = ctl
    
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                Cbo.m_Cbo.BackColor = 62207
                Cbo.m_Cbo.BackStyle = 0
                
                Cbo.m_Cbo.BeforeUpdate = EP
                Cbo.m_Cbo.OnDirty = EP
                
                Coll.Add Cbo
                Set Cbo = Nothing
                
        Case "ListBox"
            
    End Select
Next
'Close all files
Close #1
Close #2

ClassInit_Exit:
Exit Sub

ClassInit_Err:
MsgBox Err & ": " & Err.Description, , "Class_Init()"
Resume ClassInit_Exit
End Sub

Private Sub Class_Terminate()
While Coll.Count > 0
    Coll.Remove 1
Wend
Set Coll = Nothing

End Sub

The red lines are inserted in the required locations to collect the Data Field and ComboBox Names and record them in separate Text Files in the Project Folder as Input to the Class Module creation Wizard. Similarly, you can insert related Code lines for other Types of Controls on the Form.

The Wizard will look for these files on the disk and check their contents. If control names are found, they will be used for building a sample Click Event Subroutine after the main object declarations and property procedure lines of code.

If the above lines are embedded in the Class_Init() subroutine, we should open and keep the Employees Form for a few seconds and close it before running the wizard options. This will create the controls list in their respective text files, using the predefined file names taken from the wizard table ListItems, through the Select Query ListItemsQ.

The TextBoxFields.txt File contents created from the Employee Form Field Names are listed below for reference:

ID
Company
Last Name
First Name
E-mail Address
Job Title
Address
City
State/Province
ZIP/Postal Code
Country/Region

The Sample Click Event Subroutine Structure Code.

The sample Click Event Subroutine Code structure, created using the Field Names from the TextBoxFields.txt File, is given below.

Private Sub txtBox_Click()
   Select Case txtBox.Name
     Case "ID"
        ' Code
 
     Case "Company"
        ' Code
 
     Case "Last Name"
        ' Code
 
     Case "First Name"
        ' Code
 
     Case "E-mail Address"
        ' Code
 
     Case "Job Title"
        ' Code
 
     Case "Address"
        ' Code
 
     Case "City"
        ' Code
 
     Case "State/Province"
        ' Code
 
     Case "ZIP/Postal Code"
        ' Code
 
     Case "Country/Region"
        ' Code
 
 
   End Select
End Sub

Remove the unwanted Control Names from the List if no Events are invoked from those controls.

Opening the ClassWizard Form.

Open the ClassWizard Form by calling the Function OpenClassWizard() from your Project through a Command Button Click Event Subroutine, with the following sample VBA Code lines:

Private Sub Command25_Click()
	VBE.CodePanes.Item(1).show
	OpenClassWizard VBE.ActiveVBProject.Name
End Sub

The OpenClassWizard() Function Code is given below.

Note: You should not create a Function with the same name: OpenClassWizard() in your Project, where the Wizard is attached as a Library database.

Dim ProjectName As String

'Public Function to Open the Wizard Form
'from the Host Application
Public Function OpenClassWizard(ByVal projName As String)
On Error GoTo OpenClassWizard_Err

ProjectName = projName
DoCmd.OpenForm "ClassWizard", acNormal
    
OpenClassWizard_Exit:
Exit Function

OpenClassWizard_Err:
MsgBox Err & ": " & Err.Description, , "OpenClassWizard()"
Resume OpenClassWizard_Exit
End Function

When the Wizard Form is open in your Application Window, select one or more items from the List of Control Types, like TextBox, Command Buttons, or any other Class Module you need, and click the Run Wizard Command Button.

The ClassWizard Form Module Code:

Option Compare Database
Option Explicit

Private obj As New Wiz_ObjInit

Private Sub Form_load()
    Set obj.O_Form = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set obj = Nothing
End Sub

The Wiz_ObjInit Intermediary Class Module VBA Code.

Option Compare Database
Option Explicit

Private Lst As Wiz_ListBox
Private oFrm As Access.Form
Private cmd As Wiz_CmdButton
Private Coll As New Collection
'----------------------------------------------------------
'Streamlining Form Module Code in Stand-alone Class Modules
'With Reusable Structured Event Subroutine Coding.
'----------------------------------------------------------
'Event Procedure Coding in Standalone Class Module is now
'made easier with Readymade Object Wrapper Class Templates
'Demo Event Subroutine is created with the Control Names.
'----------------------------------------------------------
'Program: Wrapper Class Template Wizard
'Author:  a.p.r. pillai
'Date  :  20/06/2024
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'----------------------------------------------------------

Public Property Get O_Form() As Form
   Set O_Form = oFrm
End Property
 
Public Property Set O_Form(ByRef objForm As Form)
   Set oFrm = objForm
   
   Class_Init
End Property

Private Sub Class_Init()
On Error GoTo Class_Init_Err
Dim ctl As Control
Const EP = "[Event Procedure]"
   
For Each ctl In oFrm.Controls
    Select Case TypeName(ctl)
        Case "ListBox"
            Set Lst = New Wiz_ListBox
            Set Lst.Obj_Form = oFrm
            Set Lst.Lst_Box = ctl
                Lst.Lst_Box.OnClick = EP
                
                Coll.Add Lst
            Set Lst = Nothing
            
        Case "CommandButton"
            Set cmd = New Wiz_CmdButton
            Set cmd.Obj_Form = oFrm
            Set cmd.Obj_cmdButton = ctl
                cmd.Obj_cmdButton.OnClick = EP
                
                Coll.Add cmd
            Set cmd = Nothing
            
    End Select
Next

Class_Init_Exit:
Exit Sub

Class_Init_Err:
MsgBox Err & ": " & Err.Description, , "Class_Init()"
Resume Class_Init_Exit
End Sub

Private Sub Class_Terminate()
    While Coll.Count > 0
        Coll.Remove 1
    Wend
    Set Coll = Nothing
    Set Lst = Nothing
    
End Sub

The Class_Init() Subroutine enables the Click Events of the ListBox and Command Button Controls.

The ListBox Wrapper Class 'Wiz_ListBox' Module VBA Code.

Option Compare Database
Option Explicit
 
Private WithEvents LstBox As Access.ListBox
Private Frm As Access.Form
'----------------------------------------------------------
'Streamlining Form Module Code in Stand-alone Class Modules
'With Reusable Structured Event Subroutine Coding.
'----------------------------------------------------------
'Event Procedure Coding in Standalone Class Module is now
'made easier with Readymade Object Wrapper Class Templates
'Demo Event Subroutine is created with the Control Names.
'----------------------------------------------------------
'Program: Wrapper Class Template Wizard
'Author:  a.p.r. pillai
'Date  :  20/06/2024
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'----------------------------------------------------------

Public Property Get Obj_Form() As Form
   Set Obj_Form = Frm
End Property
 
Public Property Set Obj_Form(ByRef objForm As Form)
   Set Frm = objForm
End Property
 
Public Property Get Lst_Box() As Access.ListBox
   Set Lst_Box = LstBox
End Property
 
Public Property Set Lst_Box(ByRef objListB As Access.ListBox)
   Set LstBox = objListB
End Property

Private Sub LstBox_Click()
On Error GoTo LstBox_Click_Err
  Select Case LstBox.Name
    Case "List1"
        Dim lCount As Integer
        Dim tmpList As ListBox
        Dim j As Integer

        Set tmpList = Frm.List1
        lCount = tmpList.ListCount - 1

        For j = 0 To lCount
            If tmpList.Selected(j) Then
                Frm.cmdRun.Enabled = True
                Exit Sub
            Else
                Frm.cmdRun.Enabled = False
            End If
        Next

  End Select
  
LstBox_Click_Exit:
Exit Sub

LstBox_Click_Err:
MsgBox Err & ": " & Err.Description, , "LstBox_Click()"
Resume LstBox_Click_Exit
End Sub

The Click Event of the ListBox Control checks for the presence of any selected Items in the ListBox. If found, enables the Command Button with the Caption 'Run Wizard'; otherwise, the Command Button is disabled.

The Command Button Wrapper Class 'Wiz_CmdButton' Module Code.

Option Compare Database
Option Explicit
 
Private WithEvents cmdButton As Access.CommandButton
Private Frm As Access.Form
'----------------------------------------------------------
'Streamlining Form Module Code in Stand-alone Class Modules
'With Reusable Structured Event Subroutine Coding.
'----------------------------------------------------------
'Event Procedure Coding in Standalone Class Module is now
'made easier with Readymade Object Wrapper Class Templates
'Demo Event Subroutine is created with the Control Names.
'----------------------------------------------------------
'Program: Wrapper Class Template Wizard
'Author:  a.p.r. pillai
'Date  :  20/06/2024
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'----------------------------------------------------------

Public Property Get Obj_Form() As Access.Form
   Set Obj_Form = Frm
End Property
 
Public Property Set Obj_Form(ByRef objForm As Access.Form)
   Set Frm = objForm
End Property
 
Public Property Get Obj_cmdButton() As Access.CommandButton
   Set Obj_cmdButton = cmdButton
End Property
 
Public Property Set Obj_cmdButton(ByRef vcmdButton As Access.CommandButton)
   Set cmdButton = vcmdButton
End Property
 
Private Sub cmdButton_Click()
On Error GoTo cmdButtonClick_Err
   Select Case cmdButton.Name
     Case "cmdClose"
        DoCmd.Close acForm, "ClassWizard"
        
        
     Case "cmdRun"
        Dim modul As Module
        Dim flag As Boolean
        Dim vbcompo As vbcomponent
        Dim tmpList As ListBox
        Dim wiz As Integer
        Dim strWiz As String

        Dim FunctionName As String
        Dim FieldListFile As String
        Dim ClsTemplate As String
        Dim s_ObjTypeName As String
        Dim s_ObjName As String
        
        Dim msg As String
        Dim lCount As Integer
        Dim j As Integer, k As Integer
        Dim qot As String
        Dim objType As Long
        Dim Dt As Double
        Dim ClsSourceFile As String
        Dim ProjectName As String
        Dim Result As Boolean
        
        qot = Chr(34)
        Set tmpList = Frm.List1
        lCount = tmpList.ListCount - 1
        k = 0

        'Validation Check
        msg = ""
        For j = 0 To lCount
          If tmpList.Selected(j) Then
                'FieldList File
                FieldListFile = CurrentProject.Path & "\" & tmpList.Column(1, j)
        
                'Chek for FieldList File on Disk
                    If Len(Dir(FieldListFile)) = 0 Then
                      Open FieldListFile For Output As #1
                        Print #1, Space(5)
                      Close #1
                    End If
        
                'Class Template Name
                ClsTemplate = tmpList.Column(2, j)
                
                msg = ""
                FunctionName = tmpList.Column(3, j)
                If Len(Nz(FunctionName, "")) = 0 Then
                    FunctionName = "CreateClassTemplate"
                End If
                
                s_ObjTypeName = tmpList.Column(4, j)
                If Len(Nz(s_ObjTypeName, "")) = 0 Then 'Control Type Name column empty
                    msg = "*** Object TypeName not specified!"
                Else
                    objType = ControlTypeCheck(s_ObjTypeName) 'Is it a Valid Control TypeName
                    If objType = 9999 Then 'Name not in specified list
                        msg = "*** object Typename: " & UCase(s_ObjTypeName) & vbCr _
                        & "Not in specified List?"
                    End If
                End If
    
                s_ObjName = tmpList.Column(5, j)
                If Len(Nz(s_ObjName, "")) = 0 Then 'Column is empty
                    msg = msg & vbCr & vbCr & "User-Defined Object Name Column is Empty!"
                End If
                If Len(msg) > 0 Then 'Errors Found
                    msg = msg & vbCr & vbCr & "Errors Found in Item: " & tmpList.Column(0, j) & _
                    vbCr & "Rectify the Errors and Re-run!"
                    MsgBox msg, vbCritical + vbOKCancel, "cmdButton_Click()"
                    Exit Sub
                Else 'No Errors then creaate Template
                'Call the Wizard
Result = CreateClassTemplate(FieldListFile, ClsTemplate, s_ObjTypeName, s_ObjName)
                    If Not Result Then
                        MsgBox "Errors Encountered for '" & ClsTemplate & "'" & vbCr _
                        & "Review/Modify the Parameter value(s) and Re-try."
                    End If
                End If
    End If

Next j
        MsgBox "Class Module Templates Created successfully!"

        'Save created Template Class modules
        DoCmd.RunCommand acCmdCompileAndSaveAllModules

     Case "cmdHelp"
        DoCmd.OpenForm "Wiz_Help", acNormal
        
   End Select

cmdButtonClick_Exit:
Exit Sub

cmdButtonClick_Err:
MsgBox Err & ": " & Err.Description, , "cmdButtonClick()"
Resume cmdButtonClick_Exit
End Sub

It runs a series of checks on the Wizard parameters and validates them before calling the CreateClassTemplate() Function with its parameters.

The Wizard will retrieve the Parameters for the selected items from the ListItems Table and check for the Field List/Control Files from the selected options on the disk. If found, then it retrieves the list of controls, if any, for the sample Event Subroutine.

After validation of parameter values, it calls the Wizard Function CreateClassTemplate(), which creates the Class Module Templates for the selected options, with predefined names in your Project's VBE Window's Navigation Pane.

The CreateClassTemplate() Wizard Function VBA Code is given below:

Public Function CreateClassTemplate(ByVal FieldListFile As String, _
ByVal ClassTemplateName As String, ByVal strObjTypeName As String, _
ByVal strObjName As String) As Boolean

'----------------------------------------------------------
'Streamlining Form Module Code in Stand-alone Class Modules
'With Reusable Structured Event Subroutine Coding.
'----------------------------------------------------------
'Event Procedure Coding in Standalone Class Module is now
'made easier with Readymade Object Wrapper Class Templates
'Demo Event Subroutine is created with the Control Names.
'----------------------------------------------------------
'Program: Wrapper Class Template Wizard
'Author:  a.p.r. pillai
'Date  :  20/06/2024
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'----------------------------------------------------------

On Error GoTo CreateClassTemplate_Err
Dim j As Long, k As Long, h As Long, CountLines As Long
Dim low As Long, high As Long
Dim FieldList() As String
Dim strItem As Variant
Dim strLines(1 To 33) As String
Dim msg As String
Dim idx As Integer
Dim spacex As String
Dim qot As String
Dim ClsPath As String
Dim vbcompo As vbcomponent

spacex = Chr(32)
qot = Chr(34)
idx = 1

strLines(idx) = "VERSION 1.0 CLASS": GoSub NextIndex
strLines(idx) = "BEGIN": GoSub NextIndex
strLines(idx) = "  MultiUse = -1": GoSub NextIndex
strLines(idx) = "End": GoSub NextIndex
strLines(idx) = "Attribute VB_Name = " & qot & ClassTemplateName & qot: GoSub NextIndex
strLines(idx) = "Attribute VB_GlobalNameSpace = False": GoSub NextIndex
strLines(idx) = "Attribute VB_Creatable = False": GoSub NextIndex
strLines(idx) = "Attribute VB_PredeclaredId = False": GoSub NextIndex
strLines(idx) = "Attribute VB_Exposed = False": GoSub NextIndex
strLines(idx) = "Option Compare Database": GoSub NextIndex
strLines(idx) = "Option Explicit": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Private WithEvents " & strObjName & " as Access." & strObjTypeName: GoSub NextIndex
strLines(idx) = "Private Frm as Access.Form": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Public Property Get Obj_Form() as Access.Form": GoSub NextIndex
strLines(idx) = "   Set Obj_Form = Frm": GoSub NextIndex
strLines(idx) = "End Property": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Public Property Set Obj_Form(ByRef objForm as Access.Form)": GoSub NextIndex
strLines(idx) = "   Set Frm = objForm": GoSub NextIndex
strLines(idx) = "End Property": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Public Property Get Obj_" & strObjName & "() as Access." & strObjTypeName: GoSub NextIndex
strLines(idx) = "   Set obj_" & strObjName & " = " & strObjName: GoSub NextIndex
strLines(idx) = "End Property": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Public Property Set Obj_" & strObjName & "(ByRef v" & strObjName & " as Access." & strObjTypeName & ")": GoSub NextIndex
strLines(idx) = "   Set " & strObjName & " = v" & strObjName: GoSub NextIndex
strLines(idx) = "End Property": GoSub NextIndex
strLines(idx) = spacex: GoSub NextIndex
strLines(idx) = "Private Sub " & strObjName & "_Click()": GoSub NextIndex
strLines(idx) = "   Select Case " & strObjName & ".Name"

'Read the Field Names into Array
Open FieldListFile For Input As #1
strItem = ""
j = 0
While Not EOF(1)
    Input #1, strItem
 If Len(Trim(Nz(strItem, " "))) > 0 Then
    j = j + 1
    ReDim Preserve FieldList(1 To j) As String
    FieldList(j) = strItem
 End If
Wend
Close #1

If j > 0 Then 'If 0 then Field List File is empty
    low = LBound(FieldList)
    high = UBound(FieldList)
End If

'Write the Array contents to file
ClsPath = CurrentProject.Path & "\TempClass.cls"
Open ClsPath For Output As #1
For k = 1 To idx
    Print #1, strLines(k)
Next

'Subroutine Lines
If j > 0 Then 'if 0 then Field List file is empty
    For h = low To high
        Print #1, "     Case " & qot & FieldList(h) & qot
        Print #1, "        ' Code"
        Print #1, spacex
    Next
End If
    Print #1, spacex
    Print #1, "   End Select"
    Print #1, "End Sub"
    Print #1, spacex
Close #1

    ' Import the class module
Set vbcompo = Application.VBE.ActiveVBProject.VBComponents.Import(ClsPath)
    
    ' Verify if the imported module is a class module
    'Compile and Save module
    If vbcompo.Type = vbext_ct_ClassModule Then
        CreateClassTemplate = True
        Kill ClsPath
    Else
        CreateClassTemplate = False
        MsgBox "Import failed: Not a class module."
    End If

CreateClassTemplate_Exit:
Exit Function

NextIndex:
idx = idx + 1
Return

CreateClassTemplate_Err:
MsgBox Err & ": " & Err.Description, , "CreateClassTemplate()"
Resume CreateClassTemplate_Exit
End Function

Check the VBE navigation pane for the newly created Template Files. They may not appear immediately in the Database navigation pane.

The Wizard's VBA Code is straightforward. The first 33 lines of Code are standard, with the change of Object Names and Type declarations inserted at appropriate positions using the Parameters obtained from the ListItems Table.

Next, it checks for the Field Names list file (or the Control Type-related Text File Names given in the ListItems Table) in the TextBoxFieldsList.txt. If Control Names are present in the Text File, they are loaded into an Array in memory.

After that, the first 33 VBA Code lines are written into the TempClass.cls Text File. If the Field List/Control Name lines are found in the Array, it creates a sample Click Event Subroutine Code within the Select Case . . . Case . . . End Select structure for ready-to-write Event Procedure Code wherever applicable.

This sample Event Subroutine structure can be copied for other Event Procedures, like BeforeUpdate(), GotFocus(), and others.

Finally, the TempClass.cls Text File is Imported into the VBE Project's Code Pane. Look for the Class Modules with the _Template Suffix to spot them quickly.

If the Import action is unsuccessful, then display an Error Message. In that case, you should investigate and find the cause of the Error, correct it, and try again.

You may highlight one or more required Object Template Options from the ListBox, and the Wizard creates them quickly. You can rename the Template Modules or copy the generated Code from the Template Module and paste it into a separate Class module for normal use. Modify the Object Names- part and use it with other types of control.

Click the Help Command Button to display the Help Form in your Application Window. The Help Form Image is shown below.

Right-click to open Large Image in New Tab/Window.

The listItems Record ID Enumerations are given below.

Enum ParamID
    wizTextBox = 1
    wizCommandButton = 2
    wizComboBox = 3
    wizListBox = 4
    wizLabel = 5
    wizOptionGroup = 6
    wizOptionButton = 7
    wizCheckBox = 8
    wizToggleButton = 9
    wizTabControl = 10
End Enum

The Control Type Validating Function Code Listing.

Public Function ControlTypeCheck(ByVal strctl As String) As Long
On Error GoTo ControlTypeCheck_Err
Dim ctrlType(1 To 10) As String
Dim ctrl(1 To 10) As Long
Dim j As Integer

For j = 1 To 10
 Select Case j
    Case 1: ctrlType(j) = "Label": ctrl(j) = acLabel '100
    Case 2: ctrlType(j) = "CommandButton": ctrl(j) = acCommandButton '104
    Case 3: ctrlType(j) = "OptionButton": ctrl(j) = acOptionButton '105
    Case 4: ctrlType(j) = "CheckBox": ctrl(j) = acCheckBox '106 
    Case 5: ctrlType(j) = "OptionGroup": ctrl(j) = acOptionGroup '107 
    Case 6: ctrlType(j) = "TextBox": ctrl(j) = acTextBox '109
    Case 7: ctrlType(j) = "ListBox": ctrl(j) = acListBox '110
    Case 8: ctrlType(j) = "ComboBox": ctrl(j) = acComboBox '111
    Case 9: ctrlType(j) = "ToggleButton": ctrl(j) = acToggleButton '122 
    Case 10: ctrlType(j) = "TabControl": ctrl(j) = acTabCtl '123  
End Select
Next

For j = LBound(ctrlType) To UBound(ctrlType)
    If ctrlType(j) = strctl Then
        ControlTypeCheck = ctrl(j): Exit For
    Else
       ControlTypeCheck = 9999 'Error
    End If
Next

ControlTypeCheck_Exit:
Exit Function

ControlTypeCheck_Err:
MsgBox Err & ": " & Err.Description, , "ControlTypeCheck()"
Resume ControlTypeCheck_Exit
End Function

I hope you are enjoying the new approach to coding with reusable VBA code and easier code maintenance, without the need to constantly interfere with the Form Design View. The 'Streamlining Form Module Code in the Standalone Cass Module' also enhances code portability to other projects, offering a significant advantage.

Demo Databases Download.

WrapperClass_Wizard.zip

Wrapper Class Module Creation Wizard

2024-05-29T18:23:00.009+05:30

Streamlining Form Module Code in Standalone Class Module.

Wrapper Class Module Wizard.

We organize the controls on a form into groups based on their type—such as TextBox/Field, CommandButton, or ComboBox—and create separate wrapper class modules for each group to manage their event subroutine code. Each class module follows a consistent structure, starting with declarations for the form and control objects in the global area, followed by the corresponding property procedures.

The event subroutines come next and require the correct TextBox/Field names from the form to write the code under each Case statement within a subroutine. Accurately memorizing control names can be difficult, which often forces developers to repeatedly consult the property sheet of the controls. This results in constant switching between the class module and the form’s design view, making the process tedious and time-consuming.

The ClassWizard Form Image.

Right-click to open Large Image in New Tab/Window.

When the database form is opened, we typically scan it for different types of controls as part of the new Streamlined Event Subroutine Coding procedure. The control names can then be saved into text files on disk, organized by control type—for example, TextBox names in one file, CommandButton names in another, and ComboBox names in a separate file. This approach makes it easier to reference control names and minimizes the need to constantly switch between the class module and the form’s design view.

So, we now have the following necessary elements for building the ClassWrapper Class Templates with Code:

Global Declaration of Objects.
The Standard Property Procedures for the declared Objects.
The Control Names are collected from the Form and written into a Text File on Disk. We can build a single Subroutine structure, with all the Field Names placed within the Select Case Statements.

Once the Wrapper Class Module Template (ClassTextBox_Template) is generated with a sample BeforeUpdate() event subroutine using the Class Wizard, you can reuse its structure for other events, such as GotFocus() or LostFocus(), by simply copying, pasting, and updating the event names. From there, you can add the specific code required for each event. Any unnecessary field names can be removed from the Case statements to keep the code clean and focused.

The Wizard’s input file, TextBoxFields.txt, stores the field names from the Employees table. These names are captured when the Employee Form is open and the Class_Init() subroutine runs in the Class_ObjInit Class Module. An example of this input file for the Class Wizard Program is shown below.

TextBoxFields.txt File contents.

ID
Company
Last Name
First Name
E-mail Address
Job Title
Address
City
State/Province
ZIP/Postal Code
Country/Region

The above Field List File is created from the Employees Form's Class_Init() Subroutine in the Class_ObjInit Intermediary Class Module.

The Employees Form Image is given below, with some not-in-use CommandButtons and ComboBoxes added for trial run purposes.

Right-click to open Large Image in New Tab/Window.

The new Class_Init() Subroutine of Employees Form, with the Text File creation Code, is listed below.

Private Sub Class_Init()
Dim ProjectPath As String
Dim txtPath As String
Dim cmdPath As String
Dim ComboPath As String
Dim ctl As Control

On Error GoTo ClassInit_Err

Const EP = "[Event Procedure]"

'Save TextBox, CommandButton & CombBox Names
'to the Text Files for creating Event Subroutine Template
ProjectPath = CurrentProject.Path & "\"

txtPath = ProjectPath & "TextBoxFields.txt"
cmdPath = ProjectPath & "CmdButtonsList.txt"
ComboPath = ProjectPath & "ComboBoxList.txt"

If Len(Dir(txtPath)) > 0 Then 'delete earlier file
  Kill txtPath
End If

If Len(Dir(cmdPath)) > 0 Then 'delete earlier file
  Kill cmdPath
End If

If Len(Dir(ComboPath)) > 0 Then 'delete earlier file
  Kill ComboPath
End If

Open txtPath For Output As #1 'TextBoxFields.txt for writing
Open cmdPath For Output As #2 'CmdButtonsList.txt
Open ComboPath For Output As #3 'ComboBoxList.txt

'Instantiate the 'Data_txtBox' Class for each TextBox
'on the Form for streamlined Event Procedures Coding
For Each ctl In Frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            Set txt = New Data_TxtBox
            Set txt.m_Frm = Frm
            Set txt.m_txt = ctl
    Print #1, ctl.Name 'write Field/TextBox Name in TextBoxFields.txt File
            
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                txt.m_txt.BackColor = 62207 'yellow
                txt.m_txt.BackStyle = 0
    
                txt.m_txt.BeforeUpdate = EP
                txt.m_txt.OnDirty = EP
                
                Coll.Add txt 'Add Data_TxtBox Class Instance to Collection
                Set txt = Nothing 'Reset txt object
      
      Case "CommandButton"
            Set cmd = New Data_CmdButton
            Set cmd.Obj_Form = Frm
            Set cmd.cmd_Button = ctl
    Print #2, ctl.Name 'write CmdButton Name in CmdButtonsList.txt File
                
                cmd.cmd_Button.OnClick = EP
                
                Coll.Add cmd
                Set cmd = Nothing
                
      Case "ComboBox"
            Set Cbo = New Data_CboBox
            Set Cbo.m_Frm = Frm
            Set Cbo.m_Cbo = ctl
    Print #3, ctl.Name 'write ComboBox Names in ComboBoxList.txt File
    
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                Cbo.m_Cbo.BackColor = 62207
                Cbo.m_Cbo.BackStyle = 0
                
                Cbo.m_Cbo.BeforeUpdate = EP
                Cbo.m_Cbo.OnDirty = EP
                
                Coll.Add Cbo
                Set Cbo = Nothing
    End Select
Next
'Close all the three files
Close #1
Close #2
Close #3

ClassInit_Exit:
Exit Sub

ClassInit_Err:
MsgBox Err & ": " & Err.Description, , "Class_Init()"
Resume ClassInit_Exit
End Sub

The BASIC Language Text File Creation, Writing/Reading Statements:

Public Sub sub writeText()
Dim strItem As String
strItem = "www.msaccesstips.com"

Open "C:\myTextFile.txt" For Output As #1 'Open file in Output/writing Mode
   Print #1, strItem
Close #1

End Sub

Read the Text Data into a Variable

Public Sub ReadText()
dim strItem as String

Open "C:\myTextFile.txt" For Input As #1 'Open File in Input/Reading Mode
   Input #1, strItem
   debug.print strItem
Close #1

End Sub

The 'As #1' part indicates that this file is the first file in the Open state. If another file is to be opened for Writing/Reading simultaneously, then that will be 'As #2'.

The sample 'ClassTextBox_Template' VBA Code generated by the ClassTemplateWizard is listed below for reference.

The ClassTextBox_Template.

Option Compare Database
Option Explicit
 
Private WithEvents TextB As Access.TextBox
Private Frm As Access.Form
 
Public Property Get Obj_Form() As Form
   Set Obj_Form = Frm
End Property
 
Public Property Set Obj_Form(ByRef objForm As Form)
   Set Frm = objForm
End Property
 
Public Property Get Text_Box() As TextBox
   Set Text_Box = TextB
End Property
 
Public Property Set Text_Box(ByRef objTextB As TextBox)
   Set TextB = objTextB
End Property
 
Private Sub TextB_BeforeUpdate(Cancel As Integer)
   Select Case TextB.Name
     Case "ID"
        ' Code
 
     Case "Company"
        ' Code
 
     Case "Last Name"
        ' Code
 
     Case "First Name"
        ' Code
 
     Case "E-mail Address"
        ' Code
 
     Case "Job Title"
        ' Code
 
     Case "Address"
        ' Code
 
     Case "City"
        ' Code
 
     Case "State/Province"
        ' Code
 
     Case "ZIP/Postal Code"
        ' Code
 
     Case "Country/Region"
        ' Code
 
   End Select
End Sub

The ClassTemplateWizard.accdb contains the Class Wizard Form. An image of the Wizard Form is provided at the top of this page. To use it, you must first attach this database as a Library Database to your current project.

Once attached, you can run the Public Function OpenClassWizard() either by typing it directly in the Debug Window or by calling it from a Command Button’s Click Event Subroutine.

After attaching ClassTemplateWizard.accdb as a Library Database (via Tools → References...), ensure it is checked in the list of available library files.

Now, follow the steps below to create the Class Template file on disk:

Steps to Create the Class Template File

Open a Form (e.g., the Employees Form) and close it after a few seconds.
- The Class_Init() Subroutine creates three text files in your database folder:
  - TextBoxFields.txt – list of TextBox names
  - CmdButtonList.txt – list of CommandButton names
  - ComboBoxList.txt – list of ComboBox names
- These files are automatically overwritten each time a new form is opened.
Run the OpenClassWizard() Function from the Debug Window.
- The Wizard Form opens behind the VBA window. Minimize the VBA window to see it.
Select TextBoxFields.txt from the left-hand ListBox in the Wizard input Form.
Select ClassTextBox_Template.cls from the right-hand ListBox.
Click the Run Wizard button.
A confirmation message will appear, informing you that ClassTextBox_Template.cls has been created in your project’s folder.
In the VBA editor, right-click the Navigation Pane (near your project’s Class Modules list, not the attached Wizard database’s list) and choose Import File....
Browse to your project folder, select ClassTextBox_Template.cls, and click Open.

The ClassTextBox_Template Class is created among the Class Modules List in the VBA Navigation Pane.

Even though the ClassTextBox_Template.cls file is generated for a specific form, it can also be reused in other forms or imported into a new project. To adapt it for a different form, simply update the TextBox names accordingly.

The Wizard functions are available in the Standard Module of the ClassTemplateWizard.accdb database. For testing purposes, you can use the sample database ClassLibrary_Main.accdb.

Demo Databases Download.

ClassTemplateWizard.zip

Classes For All Data Entry Editing Forms

2024-05-16T17:41:00.009+05:30

Streamlining Form Module Code in Standalone Class Module.

Ready-made Class Modules for Data-Entry, Editing, or Viewing.

All the TextBox and ComboBox Controls, on the data handling Form, when enabled with the Dirty() and BeforeUpdate() Event Procedures, are fully protected from unintentional changes.

Manually writing code for every TextBox and ComboBox on a form can lead to duplication of work and inefficiency. Moreover, modifying event procedure names for each field to match the control name can become tedious and prone to mistakes. Typically, only essential fields undergo this kind of data protection exercise, leaving others vulnerable.

To streamline this process, consider implementing a more automated or systematic approach, such as leveraging reusable code structures, like Standalone Class Modules, that help to centralize and organize Event Procedures more efficiently.

Utilizing a Class Module with VBA Coding enables a swift and automated solution to implement data protection methods across all fields on the form. By leveraging event Dirty() and BeforeUpdate() Subroutine Code reuse techniques, these data-protecting procedures can be efficiently applied to all Text Boxes and Combo Boxes on the form. This streamlined approach ensures quick and consistent implementation of data protection measures, enhancing the overall robustness and security of the form's data handling processes.

With the following few Simple Steps, let us do a Demo Run to understand how it works:

Use the Form-Wizard to create a Form: Columnar or Tabular Design using any Table/Query as a data source.
Open the Form in Design View.
Display the Form Property Sheet and Select the Other Tab.
Change the Has Module Property Value to Yes.
Display the Form Module.

Copy and Paste the following VBA Code into the Form Module.

Option Compare Database
Option Explicit

Private Cls As New Class_ObjInit

Private Sub Form_Load()
Set Cls.o_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set Cls = Nothing
End Sub

Sample Form Image with the Employees Table.

Save your Form, but do not open it at this time. We need to create the Class Modules first.

Right-click to open Large Image in New Tab/Window.

There are three ready-made Class Modules, with a single prewritten OnDirty() and BeforeUpdate() Event Procedures. The Class_ObjInit Class Module is instantiated in the global declaration area, with the object name Cls. When the Form is open, and in the Form_Load() Event Procedure, the Cls.o_Frm Property of the Class Module is assigned to the current Form Object, Me.

When the Class_ObjInit Class Object is instantiated, the Data_TxtBox Class and the Data_CboBox Classes declared in the Class_ObjInit Class are also loaded into memory. We will create these Class Modules with the Event Subroutine Codes next.

Open the VBA Editing Window (ALT+F11)
Create a Class Module, and then click on the Properties Window Icon (located between the Project Explorer and Object Browser Icons) to display the Property Sheet of the Module. Change the Module Name from Class1 to Class_ObjInit.

Copy the VBA Code given below, paste it into the Class_ObjInit Class Module, and save it.

The Class_ObjInit Class Module.

Option Compare Database
Option Explicit

Private txt As Data_TxtBox
Private Cbo As Data_CboBox
Private Coll As New Collection
Private frm As Form
Private DetSec As Section

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'With Reusable Code
'------------------------------------------------------
'Quick Data Entry Screen
'Saving Table/Query Records in Collection Object
'Author:  a.p.r. pillai
'Date  :  10/05/2024
'Remarks: with Ready-made Data Entry Events Handler
'       : in the Wrapper TextBox Class Module
'       : Suitable for Columnar, Tabular or DataSheet Form
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get o_Frm() As Form
    Set o_Frm = frm
End Property

Public Property Set o_Frm(ByRef vFrm As Form)
    Set frm = vFrm

    Class_Init
End Property

Private Sub Class_Init()
Dim fldNames() As String
Dim j As Long
Dim Path As String
Dim ctl As Control

On Error GoTo ClassInit_Err

Set DetSec = frm.Section(acDetail)

Const EP = "[Event Procedure]"

'Save Form Detail Section Field Names
'to this Text File for creating Event Subroutine Template

Path = CurrentProject.Path & "\EventSubFields.txt"
If Len(Dir(Path)) > 0 Then
  Kill Path
End If

Open Path For Output As #1

'Instantiate the 'Data_txtBox' Class for each TextBox
'on the Form for streamlined Event Procedures Coding
j = 0
For Each ctl In DetSec.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
        
        j = j + 1
        ReDim Preserve fldNames(1 To j) As String
        fldNames(j) = ctl.Name
        
            Set txt = New Data_TxtBox
            Set txt.m_Frm = frm
            Set txt.m_txt = ctl
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                txt.m_txt.BackColor = 62207 'RGB(&HFF, &HF2, &H0):Yellow Background
                txt.m_txt.BackStyle = 0 'Transparent
            
    Print #1, ctl.Name 'write Field Name in EventSubFields.txt File
    
                txt.m_txt.BeforeUpdate = EP
                txt.m_txt.OnDirty = EP
                
                Coll.Add txt 'Add Data_TxtBox Class Instance to Collection
                Set txt = Nothing 'Reset txt object
      
      Case "ComboBox"
            Set Cbo = New Data_CboBox
            Set Cbo.m_Frm = frm
            Set Cbo.m_Cbo = ctl
            
'//Colin Riddington Technique: Highlighting BackColor on GotFocus
                Cbo.m_Cbo.BackColor = 62207 'RGB(&HFF, &HF2, &H0)
                Cbo.m_Cbo.BackStyle = 0
                
                Cbo.m_Cbo.BeforeUpdate = EP
                Cbo.m_Cbo.OnDirty = EP
                Coll.Add Cbo
                Set Cbo = Nothing
    End Select
Next
Close #1 'Close Text File

ClassInit_Exit:
Exit Sub

ClassInit_Err:
MsgBox Err & ": " & Err.Description, , "Class_Init()"
Resume ClassInit_Exit
End Sub

We instantiated the Class_ObjInit Class Module in the Form Module and assigned the Form object to its Property o_Frm. After receiving the Form Object in the Set Property Procedure, the Class_Init() Subroutine is called.

The Code lines in red in this Module will create a Text File EventSubFields.txt to save the Data Field Names from the detail section of the Form. The purpose of this Field List will be explained later on.

The Data_TxtBox Class is instantiated for each TextBox Control, the Data_CboBox Class (we will create both these Class Modules next) is instantiated for each ComboBox Control on the Form, the Dirty() and BeforeUpdate() Events are enabled by setting the text "[Event Procedure]" in their OnDirty and BeforeUpdate Event Properties.

NB: If you have not gone through this topic's earlier Pages, then you may find most of the discussion on this page somewhat strange. Find this topic's earlier page links at the end of this Page. You may visit those Pages, starting from the first one onwards. It starts with the Basics of this Coding concept of 'Form Module Event Subroutine coding in the Standalone Class Module'. The Class_ObjInit Class Module's Code and its usages are almost the same in all the earlier examples, too.

The BackColor Property is set to Yellow, and the BackStyle Property is set to Transparent so that the TextBox/ComboBox background highlights only when the Focus is on the Control.

After these changes, the TextBox or ComboBox Wrapper Class Module Instance is added as a Collection Object Item to keep them active in memory. When the Events are fired from the Controls on the Form, they are trapped in the TextBox Instance in the Collection Object and execute the Event Subroutine Code.

Remember, each TextBox on the Form has a Data_TxtBox Class Instance created, assigned with the TextBox Reference from the Form, and inserted into the Collection Object Item. When the Dirty() or BeforeUpdate() Event fires from that particular TextBox, it is captured in the Data_TxtBox Class Instance representing that TextBox to execute the Event Subroutines.

This is the new VBA Event Subroutine Coding approach that I have designed for ease of VBA Coding in Standalone Class Modules instead of in Form/Report Modules. This Coding approach has the following advantages:

Reuse the Event Procedure Code without manual duplication of Event Procedures
Need only one structured Event Subroutine per Event (say BeforeUpdate()) for all Controls of the same Type (for all TextBoxes on the Form), and all the Event Procedure Codes are organized within a single Event Subroutine.
Direct access to the Event Subroutines without interfering with the Form/Report Design
It eliminates the need for interacting with the Form/Report Design View for Code maintenance every time, resulting in faster Project completion.

Create another Class Module, and change its name to Data_TxtBox. Copy the following VBA Code, paste it into the Data_TxtBox Class Module, and save it:

The Data_txtBox TextBox Class Module Code.

Option Compare Database
Option Explicit

Private WithEvents mtxt As TextBox
Private mfrm As Form

Dim msgtxt As String
Const cr = vbCr

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'With Reusable Code
'------------------------------------------------------
'Quick Data Entry Screen
'Author:  a.p.r. pillai
'Date  :  10/05/2024
'Remarks: with Ready-made Data Entry Events Handlers
'       : in the Wrapper TextBox Class Module
'       : Suitable for Columnar, Tabular or DataSheet Form
'       : made for Table/Query.
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get m_Frm() As Form
    Set m_Frm = mfrm
End Property

Public Property Set m_Frm(ByRef vmFrm As Form)
    Set mfrm = vmFrm
End Property

Public Property Get m_txt() As TextBox
    Set m_txt = mtxt
End Property

Public Property Set m_txt(ByRef vmtxt As TextBox)
    Set mtxt = vmtxt
End Property

Private Sub mtxt_Dirty(Cancel As Integer)
'Global area of Subroutine

'If new Record Data Entry then ignore Dirty Event
If mfrm.NewRecord Then
 Exit Sub
End If

'VBA Code Runs for all Fields in the Detail Section

msgtxt = "Editing Field [" & UCase(mtxt.Name) & "]?: " _
& mtxt.Value & cr & cr & "Allow the Change?"

    If MsgBox(msgtxt, vbYesNo + vbQuestion, _
    mtxt.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
        mtxt.Undo
    End If

'Field Specific Code for validation checks
'----------------------------------------------
'If Field Specific Event handling is required
'then make a Copy of the Data_TxtBox Class with
'a New Name and use with Fieldname based Event Procedure.
'----------------------------------------------
   Select Case mtxt.Name
     Case "ID"
        ' Code
 
     Case "Company"
        ' Code
        
     Case "Last Name"
        ' Code
        
     Case "First Name"
        ' Code
 

   End Select

End Sub


Private Sub mtxt_BeforeUpdate(Cancel As Integer)
'Global area of Subroutine
'VBA Code Runs for all Fields in the Detail Section

'If new Record Data Entry then ignore BeforeUpdate Event
If mfrm.NewRecord Then
 Exit Sub
End If


msgtxt = mtxt.Name & " Old Value: " & mtxt.OldValue & _
cr & cr & "Update to ?: " & mtxt.Value

    If MsgBox(msgtxt, vbYesNo + vbQuestion, mtxt.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
        mtxt.Undo
    End If

'----------------------------------------------
'If Field Specific Event handling is required
'then make a Copy of the Data_TxtBox Class with
'a New Name and use it.
'----------------------------------------------
'Copy and Paste Cls_EventSub_Template Code here

   Select Case mtxt.Name 'Replace with
     Case "ID"
        ' Code
 
     Case "Company"
        ' Code
        
     Case "Last Name"
        ' Code
        
     Case "First Name"
        ' Code

 
   End Select


End Sub

The TextBox Class has the mtxt_Dirty() Event Procedure that monitors the active TextBox for data change attempts by the user. When a key press is detected in a Field, a message will appear asking whether the user wants to change the data. If the response is positive, then it allows us to make changes to the field.

When the changed data is about to be saved, the mtxt_BeforeUpdate() Event fires, and at this point, the system prompts to reconfirm the changes. If the response is negative, then the changes are reversed and the original value is restored.

The Dirty() and BeforeUpdate() Event Subroutines protect the data of all the Fields/TextBoxes in the Form's Detail Section.

Within the Select Case . . . End Select structure, some Field Names from the Employees Form are shown below. If we need to write VBA Code with specific requirements for Field(s), then we need to write them in this Structure under each Field Name. We will address this aspect and the appropriate steps to take later. For now, it is presented for informational purposes only.

Create another Class Module Named Data_CboBox for the ComboBox Controls on the Form. Copy the following VBA Code, paste it into the Data_CboBox Class Module, and save the Module.

The Data_CboBox ComboBox Class Module Code.

Option Compare Database
Option Explicit

Private WithEvents mCbo As ComboBox
Private mfrm As Form
Dim msgtxt As String
Const cr = vbCr

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'With Reusable Code
'------------------------------------------------------
'Quick Data Entry Screen
'Author:  a.p.r. pillai
'Date  :  10/05/2024
'Remarks: with Ready-made Data Entry Events Handler
'       : in the Wrapper TextBox Class Module
'       : Suitable for Columnar, Tabular or DataSheet Form
'       : made for Table/Query.
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get m_Frm() As Form
    Set m_Frm = mfrm
End Property

Public Property Set m_Frm(ByRef vmFrm As Form)
    Set mfrm = vmFrm
End Property

Public Property Get m_Cbo() As ComboBox
    Set m_Cbo = mCbo
End Property

Public Property Set m_Cbo(ByRef vmCbo As ComboBox)
    Set mCbo = vmCbo
End Property

Private Sub mCbo_Dirty(Cancel As Integer)
'Global area of Subroutine

'If new Record Data Entry then ignore Dirty Event
If mfrm.NewRecord Then
 Exit Sub
End If

'VBA Code Runs for all Fields in the Detail Section

msgtxt = "Editing ComboBox [" & UCase(mCbo.Name) & "]?: " _
& mCbo.Value & cr & cr & "Allow the Change?"

    If MsgBox(msgtxt, vbYesNo + vbQuestion, mCbo.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
        mCbo.Undo
    End If

Select Case mCbo.Name
    Case "Combo1"
        'Code
        
    Case "Combo2"
        'Code
        
End Select
    
End Sub

Private Sub mCbo_BeforeUpdate(Cancel As Integer)
'Global area of Subroutine
'VBA Code Runs for all Fields in the Detail Section

'If new Record Data Entry then ignore BeforeUpdate Event
If mfrm.NewRecord Then
 Exit Sub
End If


msgtxt = mCbo.Name & " Old Value: " & mCbo.OldValue & _
cr & cr & "Update to ?: " & mCbo.Value

    If MsgBox(msgtxt, vbYesNo + vbQuestion, mCbo.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
        mCbo.Undo
    End If


Select Case mCbo.Name
    Case "Combo1"
        'Code
        
    Case "Combo2"
        'Code
        
End Select
    
End Sub

The ComboBox Event Procedure is the same as the TextBox Code.

The active Field background will be highlighted yellow when the Field receives the Focus.

Save all the Modules and compile them from the VBA Window to ensure that everything is ok.

Test Running the Form.

Open the Form in Normal View.
Click on a field and press any key to begin editing. A confirmation message will appear, asking whether you want to proceed with editing the field. The OnDirty event is enabled on all TextBoxes and ComboBoxes to safeguard against accidental data changes.
If your response is Yes, then you are allowed to edit the Field. Type one or two characters at the end of the existing text in the field, then press the Enter Key.
While saving the changes, the BeforeUpdate() Event will fire, and a message will appear again asking you to reconfirm the update action. If your response is negative, then changes are reversed to the original value.

Data Entry, Editing, and Viewing.

The Class Modules are designed to work with any Form created for Data Entry, Editing, or Data View purposes.

The form can be created either with the Form Wizard or manually in Columnar, Tabular, or Datasheet layout, using a Table or Query as the data source. You may choose to include specific fields or all fields from the source table or query.
After creating a Form, copy the VBA Code from the Form1 Module, paste it into the new Form Module, save the Form, and open it in normal view.

With the above two steps, your Form is ready with all the supporting Programs, and the data is fully protected from changes. How much time does it take to do the above two steps?

The Program will monitor the Fields in Text Boxes and ComboBoxes (if present) on the Form.

The Dirty() and BeforeUpdate() event procedures are applied to all TextBox and ComboBox controls (if present) on the form.

When the Form is in Data Entry Mode (for a new Record), the OnDirty() and BeforeUpdate() Events are disabled.

Data Validation Checks.

The validation requirements of each Field are different. The Validation checks can be performed in two different ways.

1. Through the Validation Rule and Validation Text Properties (recommended) of the Table or through these Properties of the TextBoxes in the Form.

2. Through VBA Code using Event Procedures.

In this Project, the recommended procedure is the first option to use the Validation Rule and Validation Text Properties of the Field in Table Design View, or in the same Properties of the TextBox Field on the Form. If it is already written in the Table Field Properties, then do not repeat it in the Form Field.

Assign an Error Message in the Validation Text Property to display the message when the entered data is invalid. For example, the Date of Birth entered into the Date Field is invalid if it is greater than Today, and the message Text can be 'Future Date Invalid'.

The Validation Rule Property accepts simple expressions to evaluate the entered data.

Example: The Last Name Field length is 15 characters or less, and the validation expression is:

Validation Rule: Is Null OR Len([Last Name]) <= 15

Validation Text: Last Name maximum 15 characters only.

The Validation Text message will appear when the Last Name is longer than 15 characters.

If certain data fields require validation, you can assign validation rules and messages either at the table field level or in the corresponding TextBox control on the form—but not necessarily in both. For more guidance on writing effective validation expressions, refer to Allen Browne’s Microsoft Access Tips page.

If the validation requirements are more complex, you can handle them with VBA. Start by copying the three Class Modules mentioned above. Next, rename them so you can easily identify which form they belong to. Finally, write the VBA event procedures under the relevant field names, just as we did in the earlier tutorial examples.

When VBA Event Procedures are written with Field/TextBox names, then those Class Modules cannot be used for any other Form without change. In such cases, follow the procedure above.

For example, With Customized VBA Code for the Employees Form.

Emp_ObjInit
Emp_TxtBox
Emp_CboBox

Then change the Class Module Name declared in the global area of the Form Module and in the Emp_ObjInit Module as shown in the following examples:

The Form Module Code change is highlighted.

Right-click to open Large Image in New Tab/Window.

The Wrapper Class Declarations in the Emp_ObjInit Class Module.

Right-click to open Large Image in New Tab/Window.

Keeping this requirement in mind, I devised a method to generate an event subroutine template using the data field names saved from the text boxes on the form. This template can then be copied into a specific event subroutine, allowing you to write the code directly below the required fields. Any unwanted field references can simply be removed from the subroutine.

The Sample Subroutine Code generated from the Field Names collected from the Form and saved in the EventSubFields.txt File is given below for reference:

Private Sub txt_BeforeUpdate(Cancel As Integer)
   Select Case txt.Name
     Case "ID"
        ' Code
 
     Case "Company"
        ' Code
 
     Case "Last Name"
        ' Code
 
     Case "First Name"
        ' Code
 
     Case "E-mail Address"
        ' Code
 
     Case "Job Title"
        ' Code
 
     Case "Address"
        ' Code
 
     Case "City"
        ' Code
 
     Case "State/Province"
        ' Code
 
     Case "ZIP/Postal Code"
        ' Code
 
     Case "Country/Region"
        ' Code
 
   End Select
End Sub

The above BeforeUpdate() Event Procedure Code Template is generated through the following procedure:

When the form is opened, the Class_ObjInit class module’s Class_Init() subroutine collects the field names from the text boxes on the form and saves them into the EventSubFields.txt file, located in the database folder. (Refer to the red-highlighted lines of code in the Class_Init() subroutine.)

Next, run the public function CreateEventTemplate (from Module1) in the Debug/Immediate window. This function will generate the event subroutine template in the class module ClsEventSub_Template, using the field names stored earlier in the EventSubFields.txt file.

Procedure to create the ClsEventSub_Template Class Module Code.

Open the required Form for a few seconds, then close it.
Open the Immediate Window, type the function name CreateEventTemplate, and press the Enter Key.
The ClsEventSub_Template Class Module will have the Event Subroutine Template with all the Fields collected from the Form.
Highlight the entire Code, then copy and paste it into the TextBox Wrapper Class Module Emp_TxtBox and change the Event Subroutine Name (if necessary to match the Object declaration and the Subroutine Name), and write the Event Subroutine Code under the Field Name.

The unwanted field names may be removed from the Copied Subroutine.

If you follow the above steps for another Form, the ClsEventSub_Template will contain the Field Names from the latest Form opened.

Demo Database Download

OneClass_DifferentForms.zip

Table Query Records in Collection Object

2024-04-29T21:43:00.016+05:30

Class Module and Collection Object.

Steps to Create a Data View Form
1. Create the Form
  - Use the built-in Access Form Wizard to create a Data View Form with the required fields from your table or query.
2. Add a ComboBox in the Form Header
  - Insert a ComboBox in the Header section of the form.
  - Set its Row Source to a field with unique values (for example, [Last Name]) from the form’s record source table/query.
  - The ComboBox will serve as a record key, allowing you to randomly retrieve the selected record from the Collection Object and display its values in unbound TextBoxes.
3. Insert a Hidden TextBox for the Key Field
  - Add an unbound TextBox in the Header of the form and name it KeyField.
  - Set its Visible property to False.
  - In its Control Source, enter the expression:
```
="[Last Name]"
```
  - If [Last Name] alone does not provide unique values, create a query that concatenates First Name and Last Name into a single expression (e.g., FullName: [FirstName] & " " & [LastName]).
  - Use this query as the form’s record source and populate the ComboBox with this new field instead.
4. Add a Close Button in the Footer
  - Insert a Command Button in the Footer of the form.
  - Name it cmdClose.
  - Set its Caption property to Close.
5. Copy VBA Code
  - Open the Form1 Module from the demo database.
  - Copy its VBA code and paste it into the module of your newly created Employees Form.
6. Save and Close
  - Save the form.
  - Close the form to complete the setup.

Right-click to open Large Image in New Tab/Window.

The Data View Form runs on the ready-made VBA code in the DATA_View Class Module. This Class Module is fully reusable—any form created using the same method with any Table or Query as the source data can use it without modification.

Once the form is opened in Normal View, simply select an item from the ComboBox. The record with the matching key value is instantly retrieved from the Collection Object and displayed in the unbound TextBoxes. Since this form is designed strictly for data viewing, all TextBoxes are locked, ensuring that the data cannot be edited.

Creating this form is extremely quick and straightforward:

You don’t need to write any code in the Form Module.
The Form Wizard automatically places and arranges the TextBoxes properly.
With just the simple steps outlined earlier, the entire setup can be completed in about five minutes—and the form is ready to run with the DATA_View Class Module.

The Ready-made Reusable Form Module Code:

Option Compare Database
Option Explicit

Private Cls As New DATA_View

Private Sub Form_Load()
Set Cls.o_frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set Cls = Nothing
End Subc

The DATA_View Class Object is instantiated in the Employees Form Module, and the current Form Object is assigned to the o_Frm() Property of the DATA_View Object.

The Ready-made Reusable DATA_View Class Module Code.

Option Compare Database
Option Explicit

Private WithEvents cbo As ComboBox
Private WithEvents cmd As CommandButton
Private oFrm As Form
Private frmSec As Section

Private Coll As New Collection
Private txtBox() As String
Private strTable As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'With Reusable Code
'------------------------------------------------------
'Quick Data View Screen
'Saving Table/Query Records in Collection Object
'Author:  a.p.r. pillai
'Date  :  26/04/2024
'Remarks: Keep Recordset in Collectuon Object
'       : and Retrieve specific record using Key
'Rights:  All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get o_frm() As Form
    Set o_frm = oFrm
End Property

Public Property Set o_frm(ByRef vfrm As Form)
    Set oFrm = vfrm
    
    Set frmSec = oFrm.Section(acDetail)
    Call Class_Init
End Property

Private Sub Class_Init()
Dim db As Database
Dim rst As Recordset
Dim flds As Integer
Dim ctl As Control
Dim k As Integer
Dim Rec() As Variant, strKey As String
Dim vKeyName As String

strTable = oFrm.RecordSource

Set cmd = oFrm.cmdClose
    cmd.OnClick = "[Event Procedure]"
    
Set cbo = oFrm.cboName
cbo.OnClick = "[Event Procedure]"

'Make the Data Field TextBoxes Unbound
'Save the Field Names on the Form into the txtBox() Array
flds = 0
For Each ctl In frmSec.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
           ctl.ControlSource = ""
           flds = flds + 1
           ReDim Preserve txtBox(1 To flds) As String
           
'Get the selected Field Names from the
'TextBoxes on the Form's Detail Section
           txtBox(flds) = ctl.Name
           ctl.Locked = True
    End Select
Next
'Set ComboBox Default Value
'Change Form Properties
oFrm.cboName.DefaultValue = "=[cboName].[column](0,0)"
oFrm.RecordSelectors = False
oFrm.NavigationButtons = False
oFrm.ScrollBars = 0

'Load the Table/Query Records into Collection Object
ReDim Rec(1 To flds) As Variant

Set db = CurrentDb
Set rst = db.OpenRecordset(strTable, dbOpenSnapshot)

'------------------------------
vKeyName = oFrm!KeyField 'Collection Key Field Value
'------------------------------

Do While Not rst.EOF
    For k = 1 To flds
       Rec(k) = rst.Fields(txtBox(k)).Value
    Next

'Key Field Name in the Form Fields
'=========================================
   strKey = rst.Fields(vKeyName).Value
'=========================================
    Coll.Add Rec, strKey 'Save Rec() Array
    rst.MoveNext
Loop

Set rst = Nothing
Set db = Nothing

End Sub

Private Sub cbo_Click()
Dim strKy As String, Record As Variant
Dim j As Long, L As Long, H As Long

'Get Selected Collection Key from ComboBox
strKy = cbo.Value
 
'Retrieve the record using Key from Collection
'and load into Variant Array Record
  
  Record = Coll(strKy)
  
  L = LBound(Record)
  H = UBound(Record)
  
'Add Field Values into corresponding Text Boxes
  For j = L To H
    oFrm(txtBox(j)) = Record(j) 'Display in Unbound TextBox
  Next
  oFrm.Requery
  
End Sub

Private Sub cmd_Click()
    DoCmd.Close acForm, oFrm.Name
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop

End Sub

Right-click to open Large Image in New Tab/Window.

Data_View VBA Code Segment-wise Review.

Note: You can instantiate the single DATA_View Class Module across multiple data display forms within the same project. If needed, you can even keep several of these forms open simultaneously and work with them independently. There’s no need to duplicate the Class Module or its VBA code—one module efficiently serves them all.

The Global Declarations.

The ComboBox and Command Button controls are declared with the WithEvents keyword to capture their events when triggered on the form. Following this, a Form object (oFrm) and a Form Section object (frmSec) are declared.

A Collection object (Coll) is then instantiated, along with the txtBox() array (a string array with an unspecified number of elements) and the string variable strTable, which stores the name of the form’s record source (table or query).

The next section defines the Form Get and Set property procedures used to capture the active form object passed from the Form_Load() Event procedure of the Employees form. In the Set property procedure, after assigning the vFrm parameter (the received form object) to the oFrm property, the Employees form’s Detail section reference is assigned to the frmSec object, and finally the Class_Init() The subroutine is called.

At the beginning of the Class_Init() Subroutine the statement:

strTable = oFrm.RecordSource

reads the Form's Record Source Property value and retains it in the srtTable Variable.

The Command Button and Combobox Object References from the Form are assigned to the cmd and cbo Objects, respectively, and are enabled with the click Events.

'Make the Data Field TextBoxes Unbound
'Save the Field Names on the Form into the txtBox() Array
flds = 0
For Each ctl In frmSec.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
           ctl.ControlSource = ""
           flds = flds + 1
           ReDim Preserve txtBox(1 To flds) As String
           
'Get the selected Field Names from the
'TextBoxes on the Form's Detail Section
           txtBox(flds) = ctl.Name
           ctl.Locked = True
    End Select
Next
'Set ComboBox Default Value
'Change Form Properties
oFrm.cboName.DefaultValue = "=[cboName].[column](0,0)"
oFrm.RecordSelectors = False
oFrm.NavigationButtons = False
oFrm.ScrollBars = 0

The For…Next loop scans through the Detail section of the form, retrieving the names of all TextBox controls (which correspond to the source data field names) and loads them into the txtBox() array. At the same time, it calculates the total number of TextBox controls and stores this value in the Flds variable.

Each TextBox is then made unbound by setting its ControlSource property to an empty string (ctl.ControlSource = ""). The txtBox() array is dynamically redimensioned at each iteration, increasing its size by one element while preserving the data already stored. The final count of fields is captured in the Flds variable.

This approach ensures that the code automatically adapts to any changes—fields added or removed from the form by the user—without requiring manual adjustments. The ComboBox's default Value is set with the Statement: =[cboName].[column](0,0).

The next four statements change the Form Properties.

vKeyName = oFrm!KeyField

The expression value, such as="[Last Name]", is read and the KeyField name (Last Name) is assigned to the variable vKeyName. The field used as the Collection Object key must contain unique values, and the same field data must also be present in the ComboBox cboName. This ensures that selecting an item from the ComboBox can be used to randomly retrieve the corresponding record from the Collection Object.ReDim Rec(1 To flds) As Variant

Set db = CurrentDb
Set rst = db.OpenRecordset(strTable, dbOpenSnapshot)

'----------------------------
vKeyName = oFrm!KeyField
'----------------------------

Do While Not rst.EOF
    For k = 1 To flds
       Rec(k) = rst.Fields(txtBox(k)).Value
    Next

'Key Value Field Name in the Form Fields
'=========================================
   strKey = rst.Fields(vKeyName).Value
'=========================================
    Coll.Add Rec, strKey
    rst.MoveNext
Loop

Rec() The array is redimensioned to match the number of data fields on the form. The field values are then read from the source table or query, one record at a time, and stored in the corresponding elements of the Rec() array. Each completed Rec() array is added as a single item in the Collection object, with the Last Name field used as the collection item key (the second parameter of the Collection object’s Add() method). Through this process, all source data records are efficiently loaded into memory within the Collection object.

Note: The source table or query may contain more fields than those placed on the form by the Form Wizard. However, the program only processes the fields whose names appear on the form; any additional fields in the source are ignored. You may freely add or remove fields from the form or rearrange their positions as needed. Just ensure that the Name property of each field remains unchanged and matches a corresponding field in the record source table or query. No modifications to the VBA code are required.

The cbo_Click() Event Subroutine.

Private Sub cbo_Click()
Dim strKy As String, Record As Variant
Dim j As Long, L As Long, H As Long

'Get Selected Collection Key from ComboBox
strKy = cbo.Value
 
'Retrieve the record using Key from Collection
'and load into Variant Array R
  
  Record = Coll(strKy)
  
  L = LBound(Record)
  H = UBound(Record)
  
'Add Field Values into corresponding Text Boxes
  For j = L To H
    oFrm(txtBox(j)) = Record(j)
  Next
  oFrm.Requery
  
End Sub

When a user selects an item from the ComboBox, the selected value is used as the Collection Object Item Key to retrieve the corresponding record and load it into the Record() array.

The array element values are read in the same order they were stored in memory, and the unbound TextBoxes are populated accordingly, based on the order in which their names were read from the form. Since the TextBoxes are locked, their contents cannot be edited.

The Data_View Class Module and accompanying Form Module code can be reused for any form created using this procedure, without modification. Ensure that the ComboBox is named cboName, and the Command Button is named cmdClose.

Data field names are taken directly from the Name property of the TextBoxes created by the Form Wizard in the Detail section of the form.

This approach allows you to create a fully functional Data View Form in just minutes, complete with ready-to-use code.

Demo Database Download

Data_InColl.zip

Streamline Filter By Character Sort

2024-04-22T23:02:00.005+05:30

Streamlining Form Module Code in Standalone Class Module.

Data Filter by Character and Sort on Form.

Version 1.0 of this Article was originally published in April 2009 and introduces a significant change in the Demo Application Version 2.0. In this version, the Event Subroutines are executed from the standalone class module, rather than from the form module.

After realizing the advantages of Event Procedures Coding in Standalone Class Modules, I found it difficult to revert to the traditional, less organized, and time-consuming Form/Report Module VBA Coding procedures.

In traditional coding, modifying the code of a specific event subroutine in a Form Module—especially when dealing with multiple types of controls—usually involves several manual steps.

Open the Form in Design View.
Select the required Control.
Display its Property Sheet.
Select the specific Event Property.
Click on the Build Button to open the Event Procedure.
Write/Modify the Code.
Save the Form with the Code.
Open the Form in Normal View to test the change.

Typically, it takes about eight steps to reach a specific event procedure in the Form Module to write, edit, and save changes. While it’s true that multiple event procedures can be modified once the form is open, steps 2 through 6 must still be repeated for each individual event procedure. This repetitive process is both tedious and time-consuming, especially when performed numerous times during development. At the same time, designing the user interface also consumes significant effort, as both activities often occur in parallel. Furthermore, any code written directly in the Form Module remains locked there and cannot be reused elsewhere, except for public functions written in a Standard Module.

If you’re a beginner VBA programmer, learning the language alongside user interface design is best accomplished through the traditional method. If you’re an experienced developer, I encourage you to experiment with streamlined VBA event procedure coding in Standalone Class Modules and see firsthand how it compares to the traditional coding style.

This approach can offer valuable insights and significantly boost coding efficiency, saving substantial project development time. Moreover, the reusable VBA code in Standalone Class Modules can be easily exported and integrated into other projects, further enhancing productivity.

Streamlined event procedure coding involves more than just moving the code from the form module to the standalone class module. It's about organizing the event procedure code in a structured and concise manner, which promotes reusability without the need for duplicating code for multiple objects of the same type in the form module. This approach enhances code maintainability and reduces redundancy, resulting in a more efficient and manageable codebase.

Direct access to the Structured Event Subroutines in the Standalone Class Module eliminates the need for struggling with the form design view to reach a particular event subroutine. This direct access streamlines the development process, making it easier to locate and modify event procedures without the hassle of navigating through the form's design view.

Example of Structured Event Subroutine Coding:

The BeforeUpdate Event Procedure Code of several TextBoxes can be written within a single BeforeUpdate() Event Subroutine.

Private Sub txt_BeforeUpdate(Cancel As Integer)

'When the BeforeUpdate Event is captured the txt object will have
'the Name of the Object fired the Event
Select Case txt.Name

Case "Quantity"
    'Code
  
  Case "UnitPrice"
    'Code
  
  Case "SaleTax"
    ' Code
  
  Case . . .
  
End Select
End Sub

The seventh episode in this series of articles is a prime example of event subroutine code Reuse and illustrates an organized, structured approach to event procedure coding. By writing just one set of GotFocus and LostFocus Event Subroutines, you can efficiently manage the behavior of 25 or more text boxes on the form when they gain or lose focus. This example offers a straightforward demonstration of how to effectively implement the concept of streamlined event procedure coding in a standalone class module, emphasizing code reusability and reduced redundancy.

Microsoft Access controls, such as TextBoxes, Command Buttons, and others, rely on event-defining, event-firing, and event-capturing mechanisms, which form the foundation of streamlined event subroutine coding. I explored these concepts in detail during my presentation to the Access User Groups (Europe) on January 3, 2024. The presentation is available as a YouTube video on the Access User Groups (Europe) channel, titled Streamlined Event Procedure Coding in Standalone Class Modules, offering valuable insights into this coding approach.

In our current project of 'Filter by Character and Sort', the Customers Form’s record source is derived from the CustomersQ query, which contains multiple records. To enhance user experience and efficiency, we’ll implement a technique that swiftly filters records by allowing users to type the first one or more characters from the customer’s selected Data Field. Utilizing the form’s filter settings, matching records will be quickly identified based on the characters typed into a text box control. This feature will streamline the process of locating specific customer records, improving overall usability.

The Customers Form Image-1 Normal Data View.

Right-click to open Large Image in New Tab/Window.

Customers Form Image-2 with Filtered Data.

Right-click to open Large Image in New Tab/Window.

The yellow-highlighted TextBox serves as the filter input control. Above it, a ComboBox lets users select the field to search—in this case, the Last Name field. As text is entered into the filter box, the system matches the beginning of the selected field’s value and filters the records accordingly. This setup enables quick and efficient record searches based on starting characters, making it easier to locate specific names that meet the criteria.

In this example, three records are initially filtered, each with a Last Name beginning with the letter G. When you type ‘r’ after ‘G’ in the yellow-highlighted filter box, the first record (which contains ‘Go…’) no longer matches and is removed from the results. This dynamic filtering approach provides precise and efficient record retrieval, updating in real time as users type, and making it easier to quickly locate records that meet the search criteria.

Right-click to open Large Image in New Tab/Window.

When the Backspace key is pressed to remove the last character from the filter TextBox, the data instantly updates to reflect the new filtering criteria based on the remaining characters. If no characters remain, the filter is cleared and the full dataset is displayed in the form’s detail section. This ensures a seamless, real-time filtering experience that intuitively responds to user input.

The Cls_ObjInit Class Module VBA Code.

Option Compare Database
Option Explicit

Private WithEvents frm As Access.Form
Private WithEvents txt As Access.TextBox
Private WithEvents cmd As Access.CommandButton
Private WithEvents cbo As Access.ComboBox

Dim txt2Filter

Public Property Get m_Frm() As Access.Form
    Set m_Frm = frm
End Property

Public Property Set m_Frm(ByRef vFrm As Access.Form)
    Set frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Const EP = "[Event Procedure]"

Set txt = frm.FilterText
Set cmd = frm.cmdClose
Set cbo = frm.cboFields

With frm
    .OnLoad = EP
    .OnUnload = EP
End With

With txt
    .OnKeyUp = EP
End With

With cmd
    .OnClick = EP
End With

With cbo
    .OnClick = EP
End With

End Sub

Private Sub cbo_Click()
    frm.FilterText = ""
    txt2Filter = ""
    frm.Filter = ""
    frm.FilterText.SetFocus
    frm.FilterOn = False
End Sub

Private Sub txt_KeyUp(KeyCode As Integer, Shift As Integer)
Dim C As Integer, sort As String
Dim L As String

On Error GoTo txt_KeyUp_Err
C = KeyCode

With frm
Select Case C
    Case 8 'backspace key
        txt2Filter = Nz(![FilterText], "")
        If Len(txt2Filter) = 1 Or Len(txt2Filter) = 0 Then
            txt2Filter = ""
            .FilterOn = False ' remove filter
            frm.Recalc
            
        Else
            txt2Filter = Left(txt2Filter, Len(txt2Filter) - 1) 'delete the last character
            If Len(txt2Filter) = 0 Then
                .FilterOn = False ' remove filter
                
            Else 'set filter and enable
                .Filter = "[" & ![cboFields] & "]" & " like '" & txt2Filter & "*'"
                ![FilterText] = txt2Filter
                
                'position cursor position at the end of the text
                If Len(!FilterText) > 0 Then
                    .Section(acFooter).SetTabOrder
                    ![FilterText].SelLength = Len(![FilterText])
                    SendKeys "{END}" 'position cursor at right end of text
                End If
                
                .FilterOn = True
            End If
        End If
       
    Case 37 'right arrow key, prevent text highlighting
        SendKeys "{END}" 'position cursor at right end of text
    
    Case 32, 48 To 57, 65 To 90, 97 To 122 'space, 0 to 9, A to Z, a to z keys
        txt2Filter = txt2Filter & Chr$(C)
        
        'First letter of words to uppercase
        ![FilterText] = StrConv(txt2Filter, vbProperCase)
        SendKeys "{END}"
        GoSub SetFilter
End Select
End With

txt_KeyUp_Exit:
Exit Sub

SetFilter:
With frm
  .Refresh
  If Len(txt2Filter) = 0 Then
        .FilterOn = False ' remove filter
  Else 'set filter and enable
        .Filter = "[" & ![cboFields] & "]" & " like '" & txt2Filter & "*'"
        .FilterOn = True
  
  ' Set sort order
        sort = IIf(!Frame10 = 1, "ASC", "DESC")
        .OrderBy = "[" & !cboFields & "] " & sort
        .OrderByOn = True
  
        .Section(acFooter).SetTabOrder 'Form Footer Section Active
  'position cursor at end of text
        ![FilterText].SelLength = Len(![FilterText])
        SendKeys "{END}"
  End If
End With
Return

txt_KeyUp_Err:
MsgBox Err.Description, , "txt_KeyUp()"
Resume txt_KeyUp_Exit
End Sub

Private Sub cmd_Click()
    DoCmd.Close acForm, frm.Name
End Sub

There are three controls in the footer of the form, each triggering simple events that run corresponding code—except for the TextBox, which handles a more complex KeyUp() event.

In this scenario, creating separate Wrapper Class Objects is unnecessary for the TextBox, ComboBox, and Command Button, since only one instance of each exists on the form.

Within the Cls_ObjInit class module, the main object instances are declared in the global section using the WithEvents keyword, enabling Event capture and execution of their respective subroutines. Additionally, a Variant-type variable, txt2Filter, is declared globally, followed by the Form Property procedures.

The Class_Init() subroutine is then called from the Set m_Frm() property procedure after receiving the form object from the Form_Load() event procedure in the form module.

Next, the txt, cmd, and cbo objects are assigned references to their respective controls on the form and enabled with the required events.

The ComboBox Click event selects a field name to serve as the Filter target. This action resets any previously applied filter.
The Command Button Click event closes the form.
The TextBox KeyUp event captures valid keystrokes, builds the input string character by character, and applies it dynamically as a filter against the field selected in the ComboBox.

The txt_KeyUp() Event Subroutine Code.

Private Sub txt_KeyUp(KeyCode As Integer, Shift As Integer)
Dim C As Integer, sort As String
Dim L As String

On Error GoTo txt_KeyUp_Err
C = KeyCode

With frm
Select Case C
    Case 8 'backspace key
        txt2Filter = Nz(![FilterText], "")
        If Len(txt2Filter) = 1 Or Len(txt2Filter) = 0 Then
            txt2Filter = ""
            .FilterOn = False ' remove filter
            frm.Recalc
            
        Else
            txt2Filter = Left(txt2Filter, Len(txt2Filter) - 1) 'delete the last character
            If Len(txt2Filter) = 0 Then
                .FilterOn = False ' remove filter
                
            Else 'set filter and enable
                .Filter = "[" & ![cboFields] & "]" & " like '" & txt2Filter & "*'"
                ![FilterText] = txt2Filter
                
                'position cursor position at the end of the text
                If Len(!FilterText) > 0 Then
                    .Section(acFooter).SetTabOrder
                    ![FilterText].SelLength = Len(![FilterText])
                    SendKeys "{END}" 'position cursor at right end of text
                End If
                
                .FilterOn = True
            End If
        End If
       
    Case 37 'right arrow key, prevent text highlighting
        SendKeys "{END}" 'position cursor at right end of text
    
    Case 32, 48 To 57, 65 To 90, 97 To 122 'space, 0 to 9, A to Z, a to z keys
        txt2Filter = txt2Filter & Chr$(C)
        
        'First letter of words to uppercase
        ![FilterText] = StrConv(txt2Filter, vbProperCase)
        SendKeys "{END}"
        GoSub SetFilter
End Select
End With

txt_KeyUp_Exit:
Exit Sub

SetFilter:
With frm
  .Refresh
  If Len(txt2Filter) = 0 Then
        .FilterOn = False ' remove filter
  Else 'set filter and enable
        .Filter = "[" & ![cboFields] & "]" & " like '" & txt2Filter & "*'"
        .FilterOn = True
  
  ' Set sort order
        sort = IIf(!Frame10 = 1, "ASC", "DESC")
        .OrderBy = "[" & !cboFields & "] " & sort
        .OrderByOn = True
  
        .Section(acFooter).SetTabOrder 'Form Footer Section Active
  'position cursor at end of text
        ![FilterText].SelLength = Len(![FilterText])
        SendKeys "{END}"
  End If
End With
Return

txt_KeyUp_Err:
MsgBox Err.Description, , "txt_KeyUp()"
Resume txt_KeyUp_Exit
End Sub

The Sub KeyUp() Event Subroutine takes only the Key Code from the Keys 0-9, A-Z, and a-z. The Backspace key removes the last character entered into the Filter Text input Textbox. Right-arrow character Code is also valid, which moves the I bar to the END of the Filter text and prevents highlighting the full text when the Input text box is refreshed.

The Backspace keypress will truncate the right-most character from the Filter input Text, and the Filter action is refreshed. When the Filter input control is empty, the data filter is reset, and full data is displayed on the Form.

The Form Module Code.

Option Compare Database
Option Explicit

'Global declaration
Private obj As New Cls_ObjInit

Private Sub Form_load()
    Set obj.m_Frm = Me
    Application.SetOption "Behavior Entering Field", 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Application.SetOption "Behavior Entering Field", 0
    Set obj = Nothing
End Sub

Filter By Character in ComboBox Items.

Right-click to open Large Image in New Tab/Window.

The screenshot above shows the second form, Customers_Combo, which demonstrates the Filter by Character feature applied to ComboBox items. The KeyUp() event subroutine is almost identical to the filter method used in the first form we reviewed earlier.

For this form, a new class module named Cbo_ObjInit has been introduced. The VBA code for the Cbo_ObjInit class module is provided below:

Option Compare Database
Option Explicit

Private WithEvents frm As Access.Form
Private WithEvents txt As Access.TextBox
Private WithEvents cmd As Access.CommandButton
Private cbo As Access.ComboBox

Dim txt2Filter

Public Property Get m_Frm() As Access.Form
    Set m_Frm = frm
End Property

Public Property Set m_Frm(ByRef vFrm As Access.Form)
    Set frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Const EP = "[Event Procedure]"

Set txt = frm.FilterText
Set cmd = frm.cmdExit
Set cbo = frm.cboCust

With frm
    .OnLoad = EP
    .OnUnload = EP
End With

With txt
    .OnKeyUp = EP
End With

With cmd
    .OnClick = EP
End With


End Sub

Private Sub txt_KeyUp(KeyCode As Integer, Shift As Integer)
Dim i As Integer
Dim SQL As String
Dim SQL1 As String
Dim SQL2 As String


On Error GoTo txtKeyUp_Err
SQL = "SELECT CustomersQ.* FROM CustomersQ ORDER BY CustomersQ.[Last Name];"

SQL1 = "SELECT CustomersQ.* FROM CustomersQ "
SQL2 = "WHERE (((CustomersQ.[Last Name]) Like '" '"Gr*"));

i = KeyCode

Select Case i
    Case 8 'backspace key
        frm.Refresh
        If Len(txt2Filter) = 1 Or Len(txt2Filter) = 0 Then
            txt2Filter = ""
        Else
            txt2Filter = Left(txt2Filter, Len(txt2Filter) - 1) 'delete the last character
        End If
        GoSub SetFilter
    Case 37 'right arrow keys
        SendKeys "{END}"
    Case 32, 48 To 57, 65 To 90, 97 To 122 'space, 0 to 9, A to Z, a to z keys
        txt2Filter = txt2Filter & Chr$(i)
        frm![FilterText] = StrConv(txt2Filter, vbProperCase)
        GoSub SetFilter
End Select

txtKeyUp_Exit:
Exit Sub

SetFilter:
  If Len(Nz(txt2Filter, "")) = 0 Then
    With frm
        .cboCust.RowSource = SQL
        .cboCust.Requery
        .cboCust.SetFocus
        .cboCust.Dropdown
    End With
  Else 'set filter and enable
        SQL = SQL1 & SQL2 & txt2Filter & "*'));"
    With frm
        .cboCust.RowSource = SQL
        .cboCust.Requery
        .cboCust.SetFocus
        .cboCust.Dropdown
    End With
  End If
Return

txtKeyUp_Err:
MsgBox Err.Description, , "txtKeyUp()"
Resume txtKeyUp_Exit
End Sub

Private Sub cmd_Click()
    DoCmd.Close acForm, frm.Name
End Sub

In the earlier approach, we applied the Form Filter method, where the characters entered into a TextBox served as filter criteria to restrict the records displayed in the form’s record source.

In contrast, the ComboBox method dynamically builds an SQL statement using the filter text entered into a TextBox. This SQL is then assigned to the Row Source of the ComboBox, refreshing its contents in real time based on the updated criteria.

Download Demo Database

FilterByChar2016.zip

Streamline Zoom-in Control Data Editing

2024-03-29T18:25:00.011+05:30

Streamlining Form Module Code in Standalone Class Module.

Editing Large Text Box Contents in Zoom-in Control.

This topic was originally published in August 2007 under the title ‘Edit Data in Zoom-in Control.’ In that example, a custom shortcut menu was created and linked to the form to activate the zoom-in control, allowing users to edit the textbox contents containing multiple lines of data, similar to the Notes field in the Employees table.

The earlier version of the customized Shortcut Menu for the Employees Form is shown below for reference.

Right-click to open Large Image in New Tab/Window.

The built-in Shortcut Menu underwent customization by designing a new button image, highlighted in the Form image by a red oval shape. This button, resembling a CRT screen, is programmed with the necessary code to execute upon clicking. However, the process of designing a new button image within the existing shortcut menu proved to be very difficult.

Opening the Zoom Control is a two-step process: first, right-click on the TextBox to display the Shortcut Menu, then select the Zoom option to open the Zoom-in Form with the active TextBox contents.

Now, we have a more efficient method: simply right-click on a TextBox to open the Zoom-in Form prefilled with its data. After editing the contents, click the [Save] command button on the Zoom Form to update the original TextBox with the revised text.

The New Version of Zoom-in Form Image.

The New Employees Form with the Zoom-in Control with the Notes Field Data is given below:

Right-click to open Large Image in New Tab/Window.

In addition to copying the data from the Employees Notes TextBox into the larger TextBox on the Zoom Form, the formatting attributes from the original TextBox on the Employees Form are also applied, ensuring consistency in appearance.

The Main Public Functions.

There are two Public Functions that run this procedure.

The ZoomOpen() Function.

Public Function ZoomOpen()
'------------------------------------------------------
'Function : Edit Data in Zoom-in Control.
'Author   : a.p.r.pillai
'Date     : 29/07/2007, 26/03/2024
'Rights(c): www.msaccesstips.com
'------------------------------------------------------
Dim varVal, ctl As Control, intFontWeight As Integer
Dim strFont As String, intFontSize As Integer
Dim boolFontstyle As Boolean
Dim lngfontColor As Long, boolFontUnderline As Boolean
Dim bkgColor As Long

On Error GoTo ZoomOpen_Err

Set ctl = Screen.ActiveControl
With ctl
   strFont = .FontName
   intFontSize = .FontSize
   intFontWeight = .FontWeight
   boolFontstyle = .FontItalic
   boolFontUnderline = .FontUnderline
   lngfontColor = .ForeColor
   'bkgColor = .BackColor
End With

   varVal = Screen.ActiveControl.Value
   DoCmd.OpenForm "Zoom", acNormal

With Screen.ActiveForm.Controls("TxtZoom")
   .Value = varVal
   .FontName = strFont
   .FontSize = intFontSize
   .FontWeight = intFontWeight
   .FontItalic = boolFontstyle
   .FontUnderline = boolFontUnderline
   .ForeColor = lngfontColor
   '.BackColor = bkgColor
End With

ZoomOpen_Exit:
Exit Function

ZoomOpen_Err:
Resume ZoomOpen_Exit
End Function

When you right-click a TextBox, the ZoomOpen() function is executed. It copies the TextBox contents into a Variant variable, opens the Zoom-in Form, and transfers the data into the larger TextBox. The original formatting attributes from the source text box are also applied to ensure the text appears the same in the Zoom-in TextBox.

After editing the text in the Zoom-in control, click the [Save] Command Button to save the changes back into the original text box of the Employees Form, and to close the Zoom-in Form.

The Zoom-in Form can be dragged and moved to a convenient position in the Application Window. The Zoom Form will open in Popup and Modal Mode, and you must close it to access other controls or Forms.

The SaveZoomData() Function.

The [Save] Command Button Click Runs the SaveZoomData() Function. The VBA Code is given below.

Public Function SaveZoomData()
'------------------------------------------------------
'Function : Save Edited Data in the Control
'Author   : a.p.r.pillai
'Date     : 29/07/2007, 26/03/2024
'Rights(c): www.msaccesstips.com
'------------------------------------------------------
Dim vartxtZoom, strControl As String

On Error GoTo SaveZoomData_Err

 vartxtZoom = Forms("Zoom").Controls("txtZoom").Value

 DoCmd.Close acForm, "zoom"
 
 If Screen.ActiveControl.Locked = True Then
   strControl = Screen.ActiveControl.Name
   MsgBox strControl & " is Read-Only, Changes discarded!"
   Exit Function
 Else
    If IsNull(vartxtZoom) = False And Len(vartxtZoom) > 0 Then
        Screen.ActiveControl.Value = vartxtZoom
    End If
 End If
 
SaveZoomData_Exit:
Exit Function

SaveZoomData_Err:
Resume SaveZoomData_Exit
End Function

The SaveZoomData() Function saves the edited data into its Source TextBox. If the Textbox is locked, the edited data cannot be saved.

In both the above Functions, we used the Screen Object to address the active Form or active Text Box control without using their object names directly, like Screen.ActiveForm, Screen.ActiveControl that has the Focus.

As I stated earlier, all you need to do is right-click on the TextBox to open the Zoom-in control and present the TextBox contents in the Zoom Window for editing.

For those who prefer using a shortcut menu to open the Zoom Control, I created a small macro-based menu that can be assigned to the Shortcut Menu Bar property of the Form or to the same property of any individual control on the Form. When applied at the Form level, the shortcut menu will appear whenever you right-click anywhere on the Form, not just on a specific control such as a TextBox. The Macro Shortcut Menu Options.

There are two Shortcut Menu options we planned to display in the Macro.

Open Zoom
Cancel

The macro Commands for the Shortcut Menu Bar are listed in the McrZoom Macro Image shown below:

Right-click to open Large Image in New Tab/Window.

The macro shown above provides two options. The first option executes the ZoomOpen() function, which opens the Zoom Form and loads the text from the active TextBox into the Zoom Control for editing. The second option simply cancels the right-click event.

2. Create the Menu Macro.

We need to create a Menu Macro and insert the Menu Options Macro: McrZoom into the Menu Macro. The Menu Macro Image is given below:

Right-click to open Large Image in New Tab/Window.

The Menu Macro name is McrControlShortcut.

The 'Shortcut Menu Bar' Property of Form and Controls.

The Menu Macro can be inserted into the Shortcut Menu Bar Property of the Form or in the same Property of the Controls on the Form.

When added to the Form Property, the Menu appears wherever you right-click on the Form. When added to a specific Control's Shortcut Menu Bar Property, the Menu appears for that Control only.

Most controls on the form have the 'Shortcut Menu Bar' property, allowing you to insert a menu macro name to display the shortcut menu. When inserted into the TextBox's property, you can even right-click on the child label of the TextBox to bring up the shortcut menu.

Normally, on the OnClick Event Property of a Command Button or a TextBox, we can insert a Macro or a Public Function Name that executes it directly when it receives a Mouse Button Click.

Despite the 'Shortcut Menu Bar' property expecting a menu bar, it directly executes the macro or function name inserted into this property when the control receives a Right-click Event. Additionally, it briefly displays a small empty menu bar.

Examples:

Text0.Shortcut Menu Bar = "Macro2"
Text0.Shortcut Menu Bar = "=ZoomOpen()"

We will experiment with both methods. Created the Macro Menu as above for easy implementation as well.

In this round of streamlining VBA code, we do not employ any object-level wrapper classes. Instead, we use only the interface class Cls_ObjInit, where we can experiment with both approaches for utilizing the Zoom control.

The Zoom Form with txtZoom TextBox.

The Zoom Form Image is given below for Reference.

Right-click to open Large Image in New Tab/Window.

The Zoom Form has two Command Buttons. One to save the edited data into its Source Textbox, and the other to cancel the operation. Both Command Button Clicks Subroutines are written in the Form Module only.

Option Compare Database
Option Explicit

Private Sub cmdSave_Click()
  Call SaveZoomData
End Sub

Private Sub cmdCancel_Click()
  DoCmd.Close acForm, "Zoom"
End Sub

The Interface Class Module Cls_ObjInit

Option Compare Database
Option Explicit

Private frm As Access.Form

Public Property Get m_Frm() As Form
  Set m_Frm = frm
End Property

Public Property Set m_Frm(ByRef vForm As Form)
  Set frm = vForm
  
  Call Class_Init
End Property

Private Sub Class_Init()
Dim opt As String

opt = "McrControlShortcut"

'opt = "=ZoomOpen()" 'Call Function directly on Right-Click

frm.ShortcutMenu = True 'True by default
Call SetupControls(opt)
       
End Sub

Private Sub SetupControls(ByVal strOpt As String)
Dim ctl As Control

For Each ctl In frm.Controls
  Select Case ctl.ControlType
Case acTextBox
    'ctl.ShortcutMenuBar = StrOpt 'For all TextBoxes
            
      Select Case ctl.Name 'Only selected TextBoxes
          Case "Title", "Address", "Notes"
          
            ctl.ShortcutMenuBar = strOpt
            
      End Select

  End Select
Next
End Sub

Private Sub Class_Terminate()
Dim opt As String

opt = ""
Call SetupControls(opt)

End Sub

The Cls_ObjInit interface class declares a Form object in the global area, followed by the property procedures for handling the Form.

After receiving the active Form object through the frm property, the Class_Init() subroutine is executed. Both Class_Init() and Class_Terminate() call the common SetUpControls() subroutine. This routine is responsible for either assigning the macro-based shortcut menu to the Shortcut Menu Bar property of the Employees Form or directly invoking the ZoomOpen() function.

The Class_Terminate() subroutine resets the Shortcut Menu Bar property, ensuring that changes made by the standalone class module Cls_ObjInit are applied dynamically.

With a small adjustment in the Class_Init() subroutine, you can configure the Shortcut Menu Bar property either for all TextBoxes (or any other control) on the Form, or restrict it to specific TextBox controls only.

The Trial Runs.

In the Class_Init() subroutine, we plan to call the SetUpControls() subroutine to dynamically configure the Shortcut Menu Bar property of the TextBox controls. To better understand its behavior, we will experiment with two alternate settings, applying them one at a time. This trial approach allows us to observe how each configuration affects the functionality of the Zoom Control feature.

opt = "McrControlShortcut"

'opt = "=ZoomOpen()" 'Call Function directly on Right-Click

frm.ShortcutMenu = True 'True by default

By default, the second line of code is kept disabled. Remember that the setting frm.ShortcutMenu = True is the default for the form. If the shortcut menu does not appear as expected, check this property in the form and correct it.

Before invoking the SetUpControls() subroutine, the parameter variable Opt is initialized with the macro menu name "McrControlShortcut". The subroutine then assigns this macro name to the TextBox control’s Shortcut Menu Bar property. When this option is active, right-clicking the TextBox displays the custom shortcut menu. Choosing “Open Zoom” from the menu runs the public function: ZoomOpen(), while the “Cancel” option simply cancels the right-click action.

When the second option in the Class_Init() subroutine is enabled (instead of the first), the right-click event bypasses the macro and directly executes the ZoomOpen() function.

Similarly, the SetUpControl() subroutine has two options for implementation. The default method assigns the Shortcut Menu Bar property only to selected TextBox controls where data is likely to exceed the visible boundary. In this example, the fields include Title, Address, and Notes. Additional fields can be included as needed, depending on the requirements.

If we plan to implement it on all the TextBoxes on the Form, then the 'ctl.ShortcutMenuBar = StrOpt can be enabled, and the following lines of VBA Code can be removed.

      Select Case ctl.Name 'Only selected TextBoxes
          Case "Title", "Address", "Notes"
          
            ctl.ShortcutMenuBar = strOpt
            
      End Select

The Employees Form Module VBA Code.

Option Compare Database
Option Explicit

Dim Cl As New Cls_ObjInit

Private Sub Form_Load()
Set Cl.m_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set Cl = Nothing
End Sub

The Interface Class Cls_ObjInit is declared and instantiated in the global declaration area of the Employees Form. In the Form_Load() Event Procedure, the Current Form Object is passed to the Form Property Procedure, and from there the Class_Init() Subroutine is called to Set the Shortcut Menu Bar Property of the TextBoxes in the Employees Form.

This trick also works on the Tabular and Datasheet Forms. Two Demo Forms, Tabular and Datasheet Employee Forms, are also provided in the Demo Database.

Download the Demo Database.

DataEditing Zoom-in Control.zip

Streamlining Code Reminder Popup Form

2024-03-19T15:12:00.007+05:30

Streamlining Form Module Code in Standalone Class Module.

Reminder Popup Form.

Introduction.

Understanding the significance of reminders is paramount. When it comes to important occasions such as a family member's or a friend's birthday, adequate preparation time is crucial. Being notified at least two days beforehand ensures that we don't overlook these events amidst our busy schedules and other pressing commitments.

When considering business-related activities, let's examine the Inventory System of a Pharmacy as an example. It's imperative to print out a list of medicines that fall below the minimum stock level or reach reorder levels on the 25th of each month to facilitate stock replenishment by placing orders promptly.

Seasonal demand requires higher stock levels of certain medicines during winter. By reviewing usage patterns from previous years, we can identify high-demand medicines and place advance orders with suppliers to ensure adequate availability before the season begins.

Tasks that require advanced alerts or scheduled notifications can be programmed to trigger a pop-up form or report with the relevant information, ensuring timely attention and prompt action. The Birthday Experiment.

Here, we will demonstrate this feature using the Employees table, which has been extended with two additional fields: BirthDate and BFlag. The BirthDate field contains the assumed date of birth for each employee. For calculation purposes, the day and month of birth are combined with the current year (e.g., 14-March-1961 becomes 14-March-2024) to determine this year’s birthday. The logical field BFlag is updated to True once the birthday greeting has been printed from the alert pop-up form.

The Alerts are programmed to run in three stages:

A pop-up form appears 48 hours before the individual's birthday and recurs again on the eve of the celebration.
The pop-up form will display on the birthday when the database is accessed. A straightforward birthday greeting card is generated directly from the pop-up form in PDF format. Upon completing the card printing process, the Employees Table field BFlag is marked as True, ensuring that the pop-up won't reappear during subsequent database openings.
If the Birthday Greetings is not printed and the BFlag Field is not set to True, then the alert pop-up will appear for the next two days after the due date, indicating overdue case(s).

Initially, we establish an input Query named Birthday_RemData, which includes a new column dedicated to computing each employee's birthday for the Current Year, sourced from the BirthDate field within the Employees1 table. The Birthday_RemData Query is the foundational dataset for categorizing data into the above three categories for pop-up forms.

The Employees1 Table Image.

The Employees1 Table image is shown below, with the required Fields for ready reference.

Reminder: Data Filtering Queries.

The SQL of the Input Query, with the current year Date of Birth, is calculated for each Employee, from the actual Date of Birth in the Table given below:

Query Name: BirthDay_RemData (Birthday Reminder Input Data).

SELECT Employees1.EmployeeID, 
[FirstName] & " " & [LastName] AS Name, 
Employees1.BirthDate, 
Employees1.BFlag, 
DateDiff("yyyy",[birthdate],Date()) AS Age, 
DateValue(Format([BirthDate],"dd/mm") & "-" & CStr(Year(Date()))) AS DueDate
FROM Employees1;

1. Query: RemindQ1_OnDate - to filter data for the Popup on the actual BirthDay:

SELECT BirthDay_RemData.*
FROM BirthDay_RemData
WHERE (((BirthDay_RemData.DueDate)=Date()) AND ((BirthDay_RemData.BFlag)=False));

2. Query: RemindQ2_Advance - to filter data for the Popup that appears two days before the BirthDay:

SELECT BirthDay_RemData.*
FROM BirthDay_RemData
WHERE (((BirthDay_RemData.BFlag)=False) AND (([DueDate]-1)=Date()))
OR (((BirthDay_RemData.BFlag)=False) AND (([DueDate]-2)=Date()));

3. Query: RemindQ3_OverDue - to filter data for the Popup that appears two days after the BirthDay, if the birthday card is not printed on the Birthday.:

SELECT BirthDay_RemData.*
FROM BirthDay_RemData
WHERE (((BirthDay_RemData.BFlag)=False) AND (([DueDate]+1)=Date())) 
OR (((BirthDay_RemData.BFlag)=False) AND (([DueDate]+2)=Date()));

The RemindQ1_OnDate Query is the source Data of the Reminder1 Popup Form. The Reminder2 and Reminder3 Forms are linked to the RemindQ2_Advance and RemindQ3_Overdue Queries, respectively. All three are Tabular Forms.

Reminder: POPUP Forms.

1. The Remnder1 Popup Form Image is given below for reference.

The employee records with birthdays matching today’s date will be displayed on the Form, showing their actual date of birth and the birthday for the current year in separate columns. You can print the greeting card by clicking the “Print PDF Greeting” Command Button. The default path of the greeting’s target location can be temporarily altered directly in the text box. You can make the change permanent in the Default Value Property of the text box in the design view.

The Advance and Overdue Reminder Popups may show Day/Month in both columns differently. The Printing option is not available in the Form Footer Section on the Advanced and Overdue Popup Forms.

The Greetings PDF file will be saved in the path indicated in the TextBox located in the Footer Section of the Form. The path displayed in the TextBox is set in the Default Value Property of the TextBox, which you can modify to direct it to your preferred path.

The Sample Greetings Card.

The sample Greetings Card image is given below for reference.

The other two Popup Form Images are given below for information.

2. Alert about upcoming Birthdays:

3. Alerts about the missed Birthday Celebrations:

How do the Popup Form(s) open automatically if the Employee's Date of Birth meets any of the criteria specified above?

It is easy, immediately after the database is open, it checks the presence of records in the above three Queries (i.e., RemindQ1_OnDate, RemindQ2_Advance, and RemindQ3_OverDue) and opens the Alert Form linked to the Queries. For this purpose, a small Function is created in the Standard Module.

The VBA Code of Checkpopup() Function.

Public Function Checkpopup()
'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================
Dim i, j, k As Integer
i = DCount("*", "RemindQ1_OnDate")
If i > 0 Then
    DoCmd.OpenForm "Reminder1", acNormal
End If

j = DCount("*", "RemindQ2_Advance")
If j > 0 Then
    DoCmd.OpenForm "Reminder2", acNormal
End If

k = DCount("*", "RemindQ3_OverDue")
If k > 0 Then
    DoCmd.OpenForm "Reminder3", acNormal
End If

End Function

Running the Popup Forms.

Now all we need to do is call this Function immediately after opening the Database. The first choice can be to create a Macro with the name AutoExec (the Auto Execute Macro) and call the Function using the RunCode Command. The name of the Macro must be AutoExec so that Access executes this macro automatically when the Database is open. Another option is to drag this Macro and drop it on the Desktop as a Shortcut. Double-click on it to open the Database and run the Macro.

Another option is to run the Function from the Form_Load() Event Subroutine of the first Form that opens when the database is open.

If there is no urgency, call the Function when the Employees Form is open, and the PopUp Form(s) will appear, if any of the three data filtering Queries, or all of them have data, after a brief delay of 3 Seconds.

This is good for experimenting with this trick and learning how it can be set up for Advanced Alert, or on-the-day or Overdue Alerts can be implemented in your other Projects.

The Employee Form-based Popup.

There are three employee forms for each Reminder category for setting up the date and experiment. All of them can be opened from a small Main Form. The Image of the Main Form is given below.

The Employees Form Image of the First Option:

When you open this Form, after a delay of about 3 seconds, the Remnder1_OnDate Popup Form will open with the Employees' Records that have their BirthDate today. If there are no records, the [Open Reminder] Command Button is disabled. If the pop-up doesn't appear, then change the Birthdate of one or two employees to match the Day and Month (don't change the year) to match the current Date.

If you close the Reminder Form by mistake, use this Command Button to open the Reminder Form again, without closing and opening the Employees Form.

There are two other Forms for experimenting with Reminders of forthcoming or overdue Reminder setups.

Streamlining VBA Event Subroutine Codes.

Now coming to the Streamlined VBA Coding Part, there are three Employee Forms with two Command Buttons on each Form. The Employee information is for display purposes only. If you plan to edit the employee's Birthdate through this Form, you are welcome, but the validation check is not performed, and full responsibility is yours. All three Forms are linked to the same Employees1 Table.

Since all three forms have two command buttons each, we need only one Command Button Wrapper Class to handle the Events of Command Button Clicks. But, we will use three different Class_Init() Interface Classes (Intermediary Class) to create separate Instances for all three Employee Forms, so that their Identity References will remain separately in memory. The 3 Seconds TimerInterval running Subroutine is also run from within this Class Module and then opens the Popup Form.

The Command Button Wrapper Class: Rm1_cmdButton - Employees Forms.

 
Option Compare Database
Option Explicit

Private WithEvents cmd As Access.CommandButton
Private mfrm As Form
Dim t As Integer
'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================

Public Property Get m_Frm() As Access.Form
  Set m_Frm = mfrm
End Property

Public Property Set m_Frm(ByRef vfrm As Access.Form)
  Set mfrm = vfrm
End Property

Public Property Get m_cmd() As Access.CommandButton
  Set m_cmd = cmd
End Property

Public Property Set m_cmd(ByRef vcmd As Access.CommandButton)
  Set cmd = vcmd
End Property

Private Sub cmd_Click()
  Select Case cmd.Name
    Case "cmdReminder1"
        DoCmd.OpenForm "Reminder1", acNormal
    Case "cmdReminder2"
        DoCmd.OpenForm "Reminder2", acNormal
    Case "cmdReminder3"
        DoCmd.OpenForm "Reminder3", acNormal
        
    Case "cmdExit1"
        DoCmd.Close acForm, "Employees1"
    Case "cmdExit2"
        DoCmd.Close acForm, "Employees2"
    Case "cmdExit3"
        DoCmd.Close acForm, "Employees3"
  End Select
End Sub

We need only one Click-Event Subroutine in the Class Module to handle the Command Button Clicks from all three Forms. The Code is not messy and remains clean and directly accessible, rather than struggling with the Form Design View to reach them in different Form Modules. The Event Procedure Code is self-explanatory.

Three Different Interface Class Modules for Different Employee Forms. We don't create Instances of the Interface Class, hence we need to create three different Interface Classes. Moreover, it runs the TimerInterval Subroutine for three different Forms.

Interface Class of Employees1 Form: Rm1_Init Class VBA Code.

 Option Compare Database
Option Explicit

Private cmd As Rm1_CmdButton
Private WithEvents frm As Form

Private Coll As New Collection
Dim t As Integer

'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================

Public Property Get m_Frm() As Form
  Set m_Frm = frm
  
End Property

Public Property Set m_Frm(ByRef vfrm As Form)
  Set frm = vfrm
  
  Call Class_Init
  
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

frm.OnTimer = EP

For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
          Select Case ctl.Name
            Case "cmdReminder1", "cmdExit1"
            Set cmd = New Rm1_CmdButton
            Set cmd.m_Frm = frm
            Set cmd.m_cmd = ctl
                cmd.m_cmd.OnClick = EP
                Coll.Add cmd
            Set cmd = Nothing
          End Select
    End Select
Next

t = 0
frm.TimerInterval = 1000
End Sub

Private Sub frm_Timer()
Dim icount As Long
On Error GoTo frmTimer_Err

t = t + 1
If t = 3 Then
    frm.TimerInterval = 0
icount = DCount("*", "RemindQ1_OnDate")
    If icount > 0 Then
        t = 0
        frm.cmdReminder1.Enabled = True
        Call PopupOpen("Reminder1")
    Else
        frm.cmdReminder1.Enabled = False
        frm.Requery
    End If
End If

frmTimer_Exit:
Exit Sub

frmTimer_Err:
MsgBox Err.Description, , "frmTimer()"
Resume frmTimer_Exit
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop

End Sub

This class module is declared within the Employee1 Form Module, with the Employee1 Form Reference being passed to the frm object declaration. Subsequently, the Class_Init subroutine is invoked. Within this subroutine's outset, the Timer Event of the Employee1 Form is enabled, followed by the creation of Command Button Instances and the procedure for enabling events. The Timer Interval is set with a 1000 Milliseconds (1 second) delay, running for three seconds. Following this 3-second delay, the record count of the ReminderQ1_OnDate Query is obtained. If the record count exceeds zero, the Reminder1_OnDate Reminder Popup Form is opened, displaying the relevant records for viewing.

Interface Class of Employees2 Form: Rm2_Init Class.

Option Compare Database
Option Explicit

Private cmd As Rm1_CmdButton
Private WithEvents frm As Form

Private Coll As New Collection
Dim t As Integer
'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================

Public Property Get m_Frm() As Form
  Set m_Frm = frm
  
End Property

Public Property Set m_Frm(ByRef vfrm As Form)
  Set frm = vfrm
  
  Call Class_Init
  
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

frm.OnTimer = EP

For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
          Select Case ctl.Name
            Case "cmdReminder2", "cmdExit2"
            Set cmd = New Rm1_CmdButton
            Set cmd.m_Frm = frm
            Set cmd.m_cmd = ctl
                cmd.m_cmd.OnClick = EP
                Coll.Add cmd
            Set cmd = Nothing
          End Select
    End Select
Next

t = 0
frm.TimerInterval = 1000
End Sub

Private Sub frm_Timer()
Dim icount As Long
On Error GoTo frmTimer_Err

t = t + 1
If t = 3 Then
    frm.TimerInterval = 0
icount = DCount("*", "RemindQ2_Advance")
    If icount > 0 Then
        t = 0
        frm.cmdReminder2.Enabled = True
        frm.Requery
  
        Call PopupOpen("Reminder2")
    Else
        frm.cmdReminder2.Enabled = False
        frm.Requery
    End If
End If

frmTimer_Exit:
Exit Sub

frmTimer_Err:
MsgBox Err.Description, , "frmTimer()"
Resume frmTimer_Exit
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop

End Sub

The only difference in this Module is the name of the Query and Command Button Names. We use the same Rm1_CmdButton Wrapper Class here also.

Rm3_Init Interface Class also has the same VBA Code with different Query and Command Button Names.

Option Compare Database
Option Explicit

Private cmd As Rm1_CmdButton
Private WithEvents frm As Form

Private Coll As New Collection
Dim t As Integer
'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================

Public Property Get m_Frm() As Form
  Set m_Frm = frm
  
End Property

Public Property Set m_Frm(ByRef vfrm As Form)
  Set frm = vfrm
  
  Call Class_Init
  
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

'frm.OnTimer = EP

For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
          Select Case ctl.Name
            Case "cmdReminder3", "cmdExit3"
                Set cmd = New Rm1_CmdButton
                Set cmd.m_Frm = frm
                    cmd.m_Frm.OnTimer = EP
                Set cmd.m_cmd = ctl
                    cmd.m_cmd.OnClick = EP
                    Coll.Add cmd
            Set cmd = Nothing
        End Select
    End Select
Next

t = 0
frm.TimerInterval = 1000

End Sub

Private Sub frm_Timer()
Dim icount As Long
'On Error GoTo frmTimer_Err

t = t + 1
If t = 3 Then
    frm.TimerInterval = 0
  icount = DCount("*", "RemindQ3_OverDue")
    If icount > 0 Then
        t = 0
        frm.cmdReminder3.Enabled = True
        frm.Requery
  
        Call PopupOpen("Reminder3")
    Else
        frm.cmdReminder3.Enabled = False
        frm.Requery
    End If
End If

frmTimer_Exit:
Exit Sub

frmTimer_Err:
MsgBox Err.Description, , "frmTimer()"
Resume frmTimer_Exit
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop

End Sub

The Popup Forms' Wrapper Class and Interface Class Module VBA Code.

Only one Wrapper Class Module and one Interface Class Module are required for all three Popup Forms to handle the Event Procedures of the Command Buttons on them. All three Forms have only Command Buttons-click Events handled in the Wrapper Class Sub_CmdButton and Interface Class Module.

The Sub_CmdButton Wrapper Class Module VBA Code.

Option Compare Database
Option Explicit

Private WithEvents cmd As Access.CommandButton
Private frm As Form
'========================================================
'Project: Reminder Popup Form
'Author : a.p.r. pillai
'Date   : March, 2024
'Rights : All Rights(c) Reserved by www.msaccesstips.com
'Remarks: Opens up preset Reminder Popup Form(s)
'       : on pre-scheuled Date/Month
'Example: Employees' Date-of-Birth Reminder.
'========================================================

Public Property Get m_Frm() As Access.Form
  Set m_Frm = frm
End Property

Public Property Set m_Frm(ByRef vfrm As Access.Form)
  Set frm = vfrm
End Property

Public Property Get m_cmd() As Access.CommandButton
  Set m_cmd = cmd
End Property

Public Property Set m_cmd(ByRef vcmd As Access.CommandButton)
  Set cmd = vcmd
End Property

Private Sub cmd_Click()
  Select Case cmd.Name
   Case "cmdPrint1"
        Call GreetingsPrint
        
    Case "cmdCancel1"
        DoCmd.Close acForm, "Reminder1"
    Case "cmdCancel2"
        DoCmd.Close acForm, "Reminder2"
    Case "cmdCancel3"
        DoCmd.Close acForm, "Reminder3"
  End Select
End Sub

Private Sub GreetingsPrint()
Dim strSQL As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim qryDef As DAO.QueryDef
Dim EID As Integer
Dim OutFile As String

'On Error GoTo GreetingsPrint_Err

Set db = CurrentDb
Set rst = db.OpenRecordset("RemindQ1_OnDate", dbOpenDynaset)

rst.MoveLast
rst.MoveFirst

Do While Not rst.EOF And Not rst.BOF
    EID = rst![EmployeeID]
    strSQL = "SELECT RemindQ1_OnDate.* FROM RemindQ1_OnDate "
    strSQL = strSQL & "WHERE (((RemindQ1_OnDate.EmployeeID)= "
    strSQL = strSQL & EID & "));"

Set qryDef = db.QueryDefs("BirthDayQ1OnDate_PDF")
    qryDef.SQL = strSQL
    db.QueryDefs.Refresh

DoCmd.OpenReport "Greetings1_PDF", acViewPreview
If MsgBox("Birthday Greetings Print Initiated, Proceed?", vbYesNo, "Greetings Print()") = vbNo Then
DoCmd.Close acReport, "Greetings1_PDF"
   Exit Sub
End If
DoCmd.Close acReport, "Greetings1_PDF"

OutFile = frm!Path & DLookup("Name", "BirthdayQ1OnDate_PDF", "EmployeeID = " & EID) & ".pdf"
DoCmd.OutputTo acOutputReport, "Greetings1_PDF", "PDFFormat(*.pdf)", OutFile, False, "", 0, acExportQualityPrint

rst.MoveNext
Loop

  rst.Close
  Set rst = Nothing
  Set db = Nothing


DoCmd.SetWarnings False
'Delete earlier saved records
DoCmd.OpenQuery "BirthDayReminder1_Del", acViewNormal

'Add latest records
DoCmd.OpenQuery "BDay_SavedQ1", acViewNormal

'Flag the Employee Record as Greetings Printed
'Reset the floags on January 1st, Next Year
DoCmd.OpenQuery "BirthDayQ_UpdateFlag1", acViewNormal
DoCmd.SetWarnings True

MsgBox "Greetings PDFs are saved in Path: " & frm!Path

GreetingsPrint_Exit:
Exit Sub

GreetingsPrint_Err:
MsgBox Err & ": " & Err.Description, , "GreetingsPrint_Click()"
Resume GreetingsPrint_Exit
End Sub

In the cmd_Click() Event Subroutine, the cmdPrint1 Command Button Click on the Reminder1 Form Calls the GreetingsPrint() Subroutine and prints the Birthday Greetings in PDF format and updates the Employees1 Table, marking the BFlag logical Field as True to prevent it from appearing in the Employee record again in the Popup Form. The Greetings will be printed for each Employee Record separately.

After printing the Popup Form, the records will be saved into a separate temporary Table: Birthday_Reminder1.

The Sub_Init Interface Class Module VBA Code.

Option Compare Database
Option Explicit

Private cmd As Sub_CmdButton
Private frm As Form
Private Coll As New Collection

Public Property Get m_Frm() As Form
  Set m_Frm = frm
  
End Property

Public Property Set m_Frm(ByRef vfrm As Form)
  Set frm = vfrm
  
  Call Class_Init
  
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

'Set frm2 = frm.BReminderSub1.Form
For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
          Select Case ctl.Name
            Case "cmdPrint1", "cmdCancel1", _
            "cmdCancel2", "cmdCancel3"
            Set cmd = New Sub_CmdButton
            Set cmd.m_Frm = frm
            Set cmd.m_cmd = ctl
                cmd.m_cmd.OnClick = EP
                Coll.Add cmd
            Set cmd = Nothing
        End Select
    End Select
Next
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop

End Sub

All three Popup Forms: Reminder1, Reminder2, and Reminder3 have Command Buttons with unique Names to Close the Forms, and all of them are included in the Class_Init() Subroutine. Because of their unique names, we could handle their Event Procedures in a Single Wrapper Class Module.

Even though the Code requirement is simple, the Standalone Class Module VBA Coding gives you much flexibility for maintaining Code in a centralized location. It needs only one Click Event Subroutine for writing Code for several Command Buttons.

Demo Database Download

RemnderPopup2.zip

Streamlining Code Database Compacting Utility

2024-02-29T13:43:00.010+05:30

Streamlining Form Module Code in Standalone Class Module.

The Database Compact/Repair Utility.

The 'Compact on Close' Option in Microsoft Access. When enabled under File --> Current Database --> Application Options, this feature automatically compacts the database every time you open and close it. Additionally, you can manually select the Compact/Repair option from the File menu to Compact and repair the active database. If you need to compact an external file, you can select the "Compact and Repair" option from the Database Tools Menu.

If you prefer not to perform the Compact and Repair process daily, you can run the Compact/Repair Utility for multiple Databases together periodically, such as weekly or biweekly. In this case, you can conveniently select those Databases from the Disk and add them to a ListBox, as illustrated in the form image below.

Right-click to open Large Image in New Tab/Window.

The ListBox is configured with the Multi-Select option, allowing you to choose multiple databases and run the Compact/Repair operation using the corresponding command button. Each selected database will be compacted individually, and its updated file size (in kilobytes) will be displayed in the second column of the ListBox. The FileBrowser Control.

The 'Add Databases' Command Button opens the File Browser Dialog Control, and you can select one or more Databases from your disk and add them to the ListBox.

Right-click to open Large Image in New Tab/Window.

The Compact/Repair Function is Running.

The selected files from the Disk are added to the DirectoryList Table, the Source Table of the ListBox. As per your Compact/Repair schedule, you may open this Compact/Repair Utility, select the required files from the ListBox, then click on the 'Compact/Repair' Command Button.

Right-click to open Large Image in New Tab/Window.

Preparing for Compact/Repair.

In the Compact/Repair Utility Program, the Database is first backed up to a temporary location. The default Backup Path shown in the Text Box above the Command Buttons is D:\Tmp\. It is defined in the Default Value Property of the TextBox and used by the Compact/Repair Utility Program.

If you would like to take any Database Backup to a different location, then change the path, like C:\Backup\ in the TextBox, before running the Compact/Repair option.

If you prefer a different location permanently, then open the Form in Design View, display the Property Sheet of the TextBox, and change the Default Value Property to your preferred location, like D:\Backup\, and see that the last character in the path is a backslash.

Note: When the same database is compacted again, the old backup file will be replaced with the new one. Till that time, the Backup File will remain safe in that location.

The Compacting Procedure goes through the following steps:

The Source File is copied to the backup location to keep a copy of the Database safe, before the Source file is compacted.
The 'DBEngine.CompactDatabase()' command is executed to perform Compact and Repair operations on the database, and repairs the data if Database corruption is detected. In the event of data corruption, there is a potential risk of data loss, and the specific information regarding the errors encountered is preserved in the System Table MSysCompactErrors. To mitigate such situations, it is advisable to restore the data from previously created database backups, if available.
All objects from the source database, including both user-created and system objects, are transferred into a new database. The new temporary database name is "db1.accdb" (or "db1.mdb" depending on the file format) and is located in the designated backup path: D:\tmp\db1.accdb. The replication process excludes the system's temporary work files, ensuring a comprehensive transfer of objects while omitting non-essential temporary data.
Deletes the Source File from its home location.
The Compacted D:\tmp\db1.accdb file is transferred to the home location with its original Database name.

Note: The Access System goes through the same procedure when you run the Compacting operation directly from the Access System, except for the Database Backup procedure.

Streamlined VBA Coding in Standalone Class Module.

Having gained insights into the utility highlighted in the previous introduction, it is now opportune to explore the streamlined event subroutine coding procedure implemented in this specific project. The necessary VBA codes for Event Subroutines are meticulously crafted within a standalone class module, enhancing code maintenance and debugging processes. This organized code structure within the standalone Class Module facilitates easy transportation to other projects, safeguarding valuable work from being entangled with less critical code in form modules. By adopting this streamlined coding approach, the practice of reusing identical code segments across controls of the same type within the form is encouraged, eliminating the need for duplicative coding efforts.

The Command Button Wrapper Class.

There exists a singular Wrapper Class designated for the Command Button Controls, along with an additional Class Module dedicated to the Intermediary or Interface Class. The Interface Class is responsible for generating instances of the Command Button Wrapper Class and facilitating the Command Button Click Events. Customarily, a Collection Object is employed to manage all Command Button Wrapper Class instances. This arrangement allows for the monitoring and capturing of Command Button Click Events triggered within the Compact/Repair Form.

The Command Button Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private cmdfrm As Form
Private WithEvents cmd As CommandButton

Private strPath As String
Private bkupPath As String
Dim lst As ListBox
Dim lstcount As Integer
Dim xtn As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Database Compact/Repair Utility
'Author: a.p.r. pillai
'Date  : 20/02/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cmd_Frm() As Form
    Set cmd_Frm = cmdfrm
End Property

Public Property Set cmd_Frm(ByRef cfrm As Form)
    Set cmdfrm = cfrm
End Property

'Command Button Property GET/SET Procedures
Public Property Get c_cmd() As CommandButton
    Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef pcmd As CommandButton)
    Set cmd = pcmd
    
    Call DefaultPath
    
End Property

'The Click Event Subroutines
Private Sub cmd_Click()
On Error GoTo cmd_Click_Err
Select Case cmd.Name
  Case "cmdQuit"
    If MsgBox("Close Compact_Repair Form?", vbOKCancel + vbQuestion, "cmd_Click") = vbOK Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If

    Case "cmdFileDialog"
        Call FileDialog 'Display selected Path & files
        cmdfrm.dbList.Requery
        
    Case "cmdCompact"
        Call DBPrepare
        
    Case "cmdDelete"
        Call DBDelete
        
End Select

cmd_Click_Exit:
Exit Sub

cmd_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmd_Click()"
Resume cmd_Click_Exit
End Sub

Private Sub DBDelete()
'Delete the selected Items from the DirectoryList Table
Dim delCount As Integer
Dim j As Integer
Dim k As Integer
Dim DB As Database
Dim dbName As String
Dim msg As String
Dim Rst As Recordset
Dim opt As Integer

On Error GoTo DBDelete_Err
opt = 0

msg = "1. Delete Selected." & vbCr & vbCr _
& "2. Delete All from List." & vbCr & vbCr _
& "3. Cancel Deletion."
While opt < 1 Or opt > 3
    opt = InputBox(msg, "Select Option.", 3)
Wend
Select Case opt
    Case 1
        GoTo Selected
    Case 2
      msg = "Empty the Database List...?"
      If MsgBox(msg, vbYesNo + vbCritical, "DeleteList()") = vbNo Then
        Exit Sub
      Else
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_ListQ"
        DoCmd.SetWarnings True
        cmdfrm.dbList.Requery
        cmdfrm.cmdDelete.eabled = False
        Exit Sub
      End If
    Case 3
        Exit Sub
End Select

Selected:
delCount = CheckList()
If delCount > 0 Then
    msg = "Delete " & delCount & " Items." & vbCr & vbCr & "Proceed...?"
    If MsgBox(msg, vbYesNo, "DBDelete()") = vbNo Then
        Exit Sub
    End If
    
    Set DB = CurrentDb
    Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
    Set lst = cmdfrm.dbList
    
For j = 0 To lstcount
    If lst.Selected(j) Then
      dbName = lst.Column(0, j)
      Rst.FindFirst "Path = '" & dbName & "'"
      If Not Rst.NoMatch Then
        Rst.Delete
        Rst.Requery
      End If
    End If
Next
Rst.Close
Set Rst = Nothing
Set DB = Nothing

lst.Requery
    MsgBox delCount & " Item(s) Deleted From List.", , "DBDelete()"
Else
    MsgBox delCount & " Item(s) Selected for Deletion!", , "DBDelete()"
End If

DBDelete_Exit:
Exit Sub

DBDelete_Err:
MsgBox Err & " : " & Err.Description, , "DBDelete()"
Resume DBDelete_Exit
End Sub

Private Sub DBPrepare()
'Preparatory Procedure for Compacting
'the selected Databases individually
Dim xselcount As Integer
Dim dbName As String
Dim ldbName As String
Dim strTmp As String
Dim i As Integer
Dim j As Integer
Dim timr As Double
Dim fs, f
Dim lockfile As String
Dim msg As String

bkupPath = cmdfrm!BackupPath
'create a Backup Folder
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(bkupPath)
    If Err = 76 Or Err > 0 Then
       Err.Clear
       fs.createfolder (bkupPath)
    End If

On Error GoTo DBPrepare_Err

'Remove existing workfiles from backup location
xselcount = CheckList()
If xselcount = 0 Then
msg = "Select Database(s) from List for Compacting!"
MsgBox msg, , "DBPrepare()"
    Exit Sub
End If

'Ensure selected database is not active
msg = "Ensure that Selected Databases are not in Use. " _
& vbCrLf & "Proceed...?"

If MsgBox(msg, vbYesNo + vbDefaultButton2 + vbQuestion, _
"DBPrepare()") = vbNo Then
   Exit Sub
End If

'Check the selected database is active or not
'if inactive then submit it to DBCompact() Program.
For j = 0 To lstcount
    If lst.Selected(j) Then
       dbName = Trim(lst.Column(0, j))
       i = InStrRev(dbName, ".")
       xtn = Mid(dbName, i) 'extract extension
       lockfile = IIf(xtn = ".mdb", "ldb", "laccdb")
       ldbName = Left(dbName, i)
       ldbName = ldbName & lockfile 'for checking the presense of lock file.
       If Len(Dir(ldbName)) > 0 Then 'database is active
          MsgBox "Database: " & dbName & vbCrLf & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If

    'Prepare for Compacting and to display the status messages.
       msg = "Compact/Repair: " & dbName & vbCrLf & "Proceed...?"
       If MsgBox(msg, vbQuestion + vbDefaultButton2 + vbYesNo, "DBPrepare()") = vbYes Then
            cmdfrm.lblNote.Visible = False
            cmdfrm.lblStat.Caption = "Working, Please wait..."
            DoEvents

    Call DBCompact(dbName) 'Run Compacting

            cmdfrm.lblStat.Caption = ""
            DoEvents

nextstep:
            Sleep 5
        End If
    End If
Next

msg = "Selected Database(s) Compacted Successfully."
MsgBox msg, , "DBPrepare()"

    Sleep 3

cmdfrm.lblNote.Visible = True
cmdfrm.lblStat.Caption = ""


strTmp = bkupPath & "db1" & xtn 'Delete the temporary file
Call KillTempFile(strTmp)

Set fs = Nothing
Set f = Nothing
Set lst = Nothing

DBPrepare_Exit:
Exit Sub

DBPrepare_Err:
MsgBox Err.Description, , "DBPrepare()"
Resume DBPrepare_Exit
End Sub

Private Sub DBCompact(ByVal strdb As String)
'Compact/Repair Database received as Parameter
Dim t As Long
Dim xdir As String
Dim strbk As String
Dim strTmp As String
Dim tmp As String
Dim chkFile As String
Dim msg As String

On Error GoTo dbCompact_Err

tmp = cmdfrm!BackupPath

strTmp = tmp & "db1" & xtn

chkFile = strTmp
Call KillTempFile(chkFile)

t = InStrRev(strdb, "\")
If t > 0 Then
   strbk = Mid(strdb, t + 1)
End If
strbk = tmp & strbk

chkFile = strbk
Call KillTempFile(chkFile)

'Make a Copy in d:\tmp folder for safe keep
msg = "Taking Backup of " & strdb & vbCrLf _
& "to " & tmp
cmdfrm.lblMsg.Caption = msg
DoEvents

'Take a Backup of Original File to the Backup Location
   FileCopy strdb, strbk

msg = "Transferring Objects from " & strdb & vbCrLf _
& "to " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/dbengine-compactdatabase-method-dao
'Compact Database to D:\tmp\db1.accdb
   DBEngine.CompactDatabase strdb, strTmp
   
' Delete uncompacted Database and Copy Compacted db1.mdb with
' the Original Name
msg = "Creating " & strdb & " from " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'Delete uncompacted file
chkFile = strdb
Call KillTempFile(chkFile)

'Create Compacted File with its original name in its home location
    DBEngine.CompactDatabase strTmp, strdb

msg = strdb & " Compacted/Repaired Successfully."

cmdfrm.lblMsg.Caption = msg
DoEvents

Call dbListUpdate(strdb) 'Update the DirectoryList Table

dbCompact_Exit:
Exit Sub

dbCompact_Err:
MsgBox Err & " : " & Err.Description, , "dbCompact()"
Resume dbCompact_Exit
End Sub

Private Function CheckList() As Integer
'Take selected items Count
Dim k As Integer
Dim xcount As Integer

On Error GoTo CheckList_Err

Set lst = cmdfrm.dbList
lstcount = DCount("*", "DirectoryList")

xcount = 0
For k = 0 To lstcount
If lst.Selected(k) Then
    xcount = xcount + 1
End If
Next

If xcount = 0 Then
   MsgBox "No Database(s)Selected."
   Exit Function
End If

CheckList = xcount

CheckList_Exit:
Exit Function

CheckList_Err:
MsgBox Err & ": " & Err.Description, , "CheckList()"
Resume CheckList_Exit
End Function

Private Sub dbListUpdate(ByVal cmpPath As String)
'Update the File Size of the Database after Compacting
On Error GoTo dbListUpdate_Err
Dim sPath As String
Dim i As Variant
Dim DB As Database
Dim Rst As Recordset
Set DB = CurrentDb
Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)

Rst.MoveFirst
Rst.FindFirst "Path = '" & cmpPath & "'"
If Not Rst.NoMatch Then
    sPath = Rst!Path
    Rst.Edit
    Rst!FileLengthKB = FileLen(sPath) / 1024 'Db size after compacting
    Rst.Update
End If

Rst.Close
cmdfrm.dbList.Requery

dbListUpdate_Exit:
Set Rst = Nothing
Set DB = Nothing
Exit Sub

dbListUpdate_Err:
MsgBox Err & ": " & Err.Description, , "dbListUpdate()"
Resume dbListUpdate_Exit
End Sub

Private Sub DefaultPath()
Dim strLoc As String
'Default path for CommonDialog Control
   strLoc = CurrentProject.Path & "\*.accdb"
   strPath = strLoc 'Assign to Global Variable strPath
   
End Sub

Private Sub FileDialog()
On Error GoTo cmdFileDialog_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim DB As DAO.Database
Dim Rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set DB = CurrentDb
        Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            strPath = defPath
         End If
            Rst.AddNew
            Rst![Path] = varFile
            Rst![FileLengthKB] = FileLen(varFile) / 1024
            Rst.Update
      Next
            cmdfrm.cmdDelete.Enabled = True
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Exit:
Exit Sub

cmdFileDialog_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Exit
End Sub

Private Sub KillTempFile(ByVal filename As String)
On Error GoTo KillTempFile_Err
'Manage Temporary Files
    If Len(Dir(filename)) > 0 Then
        Kill filename
    End If

KillTempFile_Exit:
Exit Sub

KillTempFile_Err:
MsgBox Err & ": " & Err.Description, , "KillTempFile()"
Resume KillTempFile_Exit
End Sub

The Command Button Wrapper Class starts with the main Properties, the Form Object, and Command Button Control declarations. The CommandButton Control is declared and qualified with the Keyword WithEvents for capturing the Click Events when fired from the Form.

A few local Variables are also declared in the global area of the Class Module, followed by the Form and Command Button Get and Set Property Procedures.

Despite four Command Buttons on the Form, a single Click Event Subroutine within the Command Button Wrapper Class suffices. This streamlined approach enables the capture of all four Command Button Clicks within the same Event Subroutine, allowing for the execution of their respective Event Procedures. This efficiency is achievable through the implementation of streamlined Event Procedure coding.

When examining the Event Subroutine Code in order of priority, the initial step involves adding the databases slated for the Compact/Repair procedure to the ListBox. This is accomplished through the Click Event of the Command Button labeled 'Add Databases,' with the name 'CmdFileDialog.' The Click Event, in turn, invokes the FileDialog() Subroutine. The Code Segment is given below:

Private Sub FileDialog()
On Error GoTo cmdFileDialog_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set db = CurrentDb
        Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            strPath = defPath
         End If
            rst.AddNew
            rst![Path] = varFile
            rst![FileLengthKB] = FileLen(varFile) / 1024
            rst.Update
      Next
            cmdfrm.cmdDelete.Enabled = True
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Exit:
Exit Sub

cmdFileDialog_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Exit
End Sub

This is the same Office.FileDialog Control (the File Browser Control) and the Program we used in the earlier Episode with the title External Files' List in Hyperlinks published earlier. If you click on this link, you will be directed to the specific part of the Page that gives its function details.

In this scenario, we utilize the DirectoryList Table to store the databases selected from the disk, which subsequently populate the ListBox on the Form. The table encompasses two fields: Path and FileLengthKB. The former accommodates the full pathname of the database, while the latter calculates the file size in kilobytes when added to the table. Following the Compact/Repair operations, this table undergoes updates to reflect the altered file sizes.

Users have the flexibility to select one or more databases from the list and initiate the Compact/Repair process by clicking on the designated Command Button. This action triggers the execution of the DBPrepare() Subroutine, which in turn identifies the selected database(s) in the ListBox and passes them to the DBCompact() Subroutine for the Compact/Repair operation.

The DBPrepare() Subroutine VBA Code.

Private Sub DBPrepare()
'Preparatory Procedure for Compacting
'the selected Databases individually
Dim xselcount As Integer
Dim dbName As String
Dim ldbName As String
Dim strTmp As String
Dim i As Integer
Dim j As Integer
Dim timr As Double
Dim fs, f
Dim lockfile As String
Dim msg As String

bkupPath = cmdfrm!BackupPath
'create a Backup Folder
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(bkupPath)
    If Err = 76 Or Err > 0 Then
       Err.Clear
       fs.createfolder (bkupPath)
    End If

On Error GoTo DBPrepare_Err

'Remove existing workfiles from backup location
xselcount = CheckList()
If xselcount = 0 Then
msg = "Select Database(s) from List for Compacting!"
MsgBox msg, , "DBPrepare()"
    Exit Sub
End If

'Ensure selected database is not active
msg = "Ensure that Selected Databases are not in Use. " _
& vbCrLf & "Proceed...?"

If MsgBox(msg, vbYesNo + vbDefaultButton2 + vbQuestion, _
"DBPrepare()") = vbNo Then
   Exit Sub
End If

'Check the selected database is active or not
'if inactive then submit it to DBCompact() Program.
For j = 0 To lstcount
    If lst.Selected(j) Then
       dbName = Trim(lst.Column(0, j))
       i = InStrRev(dbName, ".")
       xtn = Mid(dbName, i) 'extract extension
       lockfile = IIf(xtn = ".mdb", "ldb", "laccdb")
       ldbName = Left(dbName, i)
       ldbName = ldbName & lockfile 'for checking the presense of lock file.
       If Len(Dir(ldbName)) > 0 Then 'database is active
          MsgBox "Database: " & dbName & vbCrLf & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If

    'Prepare for Compacting and to display the status messages.
       msg = "Compact/Repair: " & dbName & vbCrLf & "Proceed...?"
       If MsgBox(msg, vbQuestion + vbDefaultButton2 + vbYesNo, "DBPrepare()") = vbYes Then
            cmdfrm.lblNote.Visible = False
            cmdfrm.lblStat.Caption = "Working, Please wait..."
            DoEvents

    Call DBCompact(dbName) 'Run Compacting

            cmdfrm.lblStat.Caption = ""
            DoEvents

nextstep:
            Sleep 5
        End If
    End If
Next

msg = "Selected Database(s) Compacted Successfully."
MsgBox msg, , "DBPrepare()"

    Sleep 3

cmdfrm.lblNote.Visible = True
cmdfrm.lblStat.Caption = ""


strTmp = bkupPath & "db1" & xtn 'Delete the temporary file
Call KillTempFile(strTmp)

Set fs = Nothing
Set f = Nothing
Set lst = Nothing

DBPrepare_Exit:
Exit Sub

DBPrepare_Err:
MsgBox Err.Description, , "DBPrepare()"
Resume DBPrepare_Exit
End Sub

The above DBPrepare() Subroutine picks the User-selected items individually and passes them to the actual Compacting Subroutine DBCompact() below for Compact/Repair operations and restoring the Compacted Database to its home location.

The DBCompact Subroutine VBA Code.

Private Sub DBCompact(ByVal strdb As String)

'Compact/Repair Database received as Parameter
Dim t As Long
Dim xdir As String
Dim strbk As String
Dim strTmp As String
Dim tmp As String
Dim chkFile As String
Dim msg As String

On Error GoTo dbCompact_Err

tmp = cmdfrm!BackupPath

strTmp = tmp & "db1" & xtn

chkFile = strTmp
Call KillTempFile(chkFile)

t = InStrRev(strdb, "\")
If t > 0 Then
   strbk = Mid(strdb, t + 1)
End If
strbk = tmp & strbk

chkFile = strbk
Call KillTempFile(chkFile)

'Make a Copy in d:\tmp folder for safe keep
msg = "Taking Backup of " & strdb & vbCrLf _
& "to " & tmp
cmdfrm.lblMsg.Caption = msg
DoEvents

'Take a Backup of Original File to the Backup Location
   FileCopy strdb, strbk

msg = "Transferring Objects from " & strdb & vbCrLf _
& "to " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/dbengine-compactdatabase-method-dao
'Compact Database to D:\tmp\db1.accdb
   DBEngine.CompactDatabase strdb, strTmp
   
' Delete uncompacted Database and Copy Compacted db1.mdb with
' the Original Name
msg = "Creating " & strdb & " from " & tmp & "db1" & xtn
cmdfrm.lblMsg.Caption = msg
DoEvents

'Delete uncompacted file
chkFile = strdb
Call KillTempFile(chkFile)

'Create Compacted File with its original name in its home location
    DBEngine.CompactDatabase strTmp, strdb

msg = strdb & " Compacted/Repaired Successfully."

cmdfrm.lblMsg.Caption = msg
DoEvents

Call dbListUpdate(strdb) 'Update the DirectoryList Table

dbCompact_Exit:
Exit Sub

dbCompact_Err:
MsgBox Err & " : " & Err.Description, , "dbCompact()"
Resume dbCompact_Exit
End Sub

There are three other small supporting Subroutines called from both the DBPrepare() and DBCompact() Subroutines.

The CheckList() Subroutine.

Private Function CheckList() As Integer
'Take selected items Count
Dim k As Integer
Dim xcount As Integer

On Error GoTo CheckList_Err

Set lst = cmdfrm.dbList
lstcount = DCount("*", "DirectoryList")

xcount = 0
For k = 0 To lstcount
If lst.Selected(k) Then
    xcount = xcount + 1
End If
Next

If xcount = 0 Then
   MsgBox "No Database(s)Selected."
   Exit Function
End If

CheckList = xcount

CheckList_Exit:
Exit Function

CheckList_Err:
MsgBox Err & ": " & Err.Description, , "CheckList()"
Resume CheckList_Exit
End Function

The above Subroutine checks whether any Item is selected in the ListBox and takes its count when the 'Compact/Repair' or 'Delete from List' Command Button is clicked. If selected, then the selected operation is performed.

The dbListUpdate() Subroutine VBA.

Private Sub dbListUpdate(ByVal cmpPath As String)
'Update the File Size of the Database after Compacting
On Error GoTo dbListUpdate_Err
Dim sPath As String
Dim i As Variant
Dim DB As Database
Dim Rst As Recordset
Set DB = CurrentDb
Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)

Rst.MoveFirst
Rst.FindFirst "Path = '" & cmpPath & "'"
If Not Rst.NoMatch Then
    sPath = Rst!Path
    Rst.Edit
    Rst!FileLengthKB = FileLen(sPath) / 1024 'Db size after compacting
    Rst.Update
End If

Rst.Close
cmdfrm.dbList.Requery

dbListUpdate_Exit:
Set Rst = Nothing
Set DB = Nothing
Exit Sub

dbListUpdate_Err:
MsgBox Err & ": " & Err.Description, , "dbListUpdate()"
Resume dbListUpdate_Exit
End Sub

This Program is called from the DBCompact() Subroutine to update the File Size in Kilobytes in the list box after compacting the Database.

The DBDelete() Subroutine.

Private Sub DBDelete()
'Delete the selected Items from the DirectoryList Table
Dim delCount As Integer
Dim j As Integer
Dim k As Integer
Dim DB As Database
Dim dbName As String
Dim msg As String
Dim Rst As Recordset
Dim opt As Integer

On Error GoTo DBDelete_Err
opt = 0

msg = "1. Delete Selected." & vbCr & vbCr _
& "2. Delete All from List." & vbCr & vbCr _
& "3. Cancel Deletion."
While opt < 1 Or opt > 3
    opt = InputBox(msg, "Select Option.", 3)
Wend
Select Case opt
    Case 1
        GoTo Selected
    Case 2
      msg = "Empty the Database List...?"
      If MsgBox(msg, vbYesNo + vbCritical, "DeleteList()") = vbNo Then
        Exit Sub
      Else
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_ListQ"
        DoCmd.SetWarnings True
        cmdfrm.dbList.Requery
        cmdfrm.cmdDelete.eabled = False
        Exit Sub
      End If
    Case 3
        Exit Sub
End Select

Selected:
delCount = CheckList()
If delCount > 0 Then
    msg = "Delete " & delCount & " Items." & vbCr & vbCr & "Proceed...?"
    If MsgBox(msg, vbYesNo, "DBDelete()") = vbNo Then
        Exit Sub
    End If
    
    Set DB = CurrentDb
    Set Rst = DB.OpenRecordset("DirectoryList", dbOpenDynaset)
    Set lst = cmdfrm.dbList
    
For j = 0 To lstcount
    If lst.Selected(j) Then
      dbName = lst.Column(0, j)
      Rst.FindFirst "Path = '" & dbName & "'"
      If Not Rst.NoMatch Then
        Rst.Delete
        Rst.Requery
      End If
    End If
Next
Rst.Close
Set Rst = Nothing
Set DB = Nothing

lst.Requery
    MsgBox delCount & " Item(s) Deleted From List.", , "DBDelete()"
Else
    MsgBox delCount & " Item(s) Selected for Deletion!", , "DBDelete()"
End If

DBDelete_Exit:
Exit Sub

DBDelete_Err:
MsgBox Err & " : " & Err.Description, , "DBDelete()"
Resume DBDelete_Exit
End Sub

To remove some databases from the ListBox, you must select them from the ListBox and click the 'Delete from List' Command Button. The DBDelete() Subroutine is called, and the selected items will be deleted from the DirectoryList table, and the ListBox will be updated to reflect the change.

The KillTempFile() Subroutine.

Private Sub KillTempFile(ByVal filename As String)
On Error GoTo KillTempFile_Err
'Manage Temporary Files
    If Len(Dir(filename)) > 0 Then
        Kill filename
    End If

KillTempFile_Exit:
Exit Sub

KillTempFile_Err:
MsgBox Err & ": " & Err.Description, , "KillTempFile()"
Resume KillTempFile_Exit
End Sub

The Compact/Repair Program creates Temporary Databases for System use and deletes them using the above Subroutine. This Subroutine is called from within the DBPrepare() and DBCompact() Subroutines.

The FLst_ObjInit Interface Class Module VBA Code.

Option Compare Database
Option Explicit

Private cmd As FLst_CmdButton
Private frm As Access.Form
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Database Compact/Repair Utility
'Author: a.p.r. pillai
'Date  : 20/02/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get Ini_Frm() As Access.Form
    Set Ini_Frm = frm.m_cFrm
End Property

Public Property Set Ini_Frm(ByRef pFrm As Access.Form)
    Set frm = pFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
On Error GoTo Class_Init_Err
Dim ctl As Control
Dim listcount As Long
Const EP = "[Event Procedure]"

listcount = DCount("*", "DirectoryList")

'If ListBox is empty then disable
'cmdDelete Command Button
If listcount = 0 Then
    frm.cmdDelete.Enabled = False
Else
    frm.cmdDelete.Enabled = True
End If

For Each ctl In frm.Controls
Select Case TypeName(ctl)
      Case "CommandButton"
        Select Case ctl.Name
            Case "cmdFileDialog", "cmdCompact", _
            "cmdDelete", "cmdQuit"
            
                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing
        End Select
End Select
Next

Class_Init_Exit:
Exit Sub

Class_Init_Err:
MsgBox Err & " : " & Err.Description, , "Class_Init()"
Resume Class_Init_Exit
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

Within the global declaration area, the FLst_CmdButton Class, the Form Object frm, and the Collection Object Coll are declared. This is succeeded by the inclusion of Get/Set Property Procedures for the frm property. In adherence to common practice, the active Form Object is passed from the Form_Load() Event Procedure into the pFrm parameter, subsequently being assigned to the Form Object frm.

Upon obtaining the reference to the active Form object within the Interface Class, in the subsequent phase of the Set Property Procedure, we invoke the Class_Init() Subroutine.

Within the Class_Init() Subroutine, a constant named "EP" is created to represent the [Event Procedure] text. Following this, a check is implemented to determine the status of the DirectoryList Table, which serves as the source data for the ListBox. If the DirectoryList table is empty, the [Delete from List] Command Button on the Form is disabled.

Within the subsequent For...Next Loop, the program iterates through the Command Buttons on the Form. When a Command Button is identified, an individual instance of the Command Button Wrapper Class is instantiated. This instance is then assigned with the respective Control Reference, and the necessary Events, specifically the Click Events in this case, are enabled. These instances are subsequently stored in the Collection Object to retain them in memory.

You may take note of the following Statements:

                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing

The first statement initiates the creation of an instance of the FLst_CmdButton Class in memory. Its cmd_frm Property is then configured with the active form object frm, and the current Command Button control Reference in ctl is transmitted to the c_cmd Property. When these two properties are armed with the references of the Form and Command Button, the resulting instance of the Command Button Wrapper Class effectively mirrors the properties and characteristics of the corresponding Command Button on the Form.

The subsequent statement, cmd.c_cmd.OnClick = EP is functionally equivalent to specifying the text [Event Procedure] in the OnClick Event Property of the Command Button. Following the activation of the Event Procedure, the current instance of the Wrapper Class is added to the Collection Object in memory. This enables the capturing of the Event when triggered from the Command Button, subsequently executing the associated Event Procedure in the Wrapper Class Module.

You should not ignore the next statement: Set cmd = Nothing.

At this point, you may be in doubt. When we execute the above statement, it will erase the Wrapper Class Instance we created in memory.

While the resemblance may be apparent, there is a crucial distinction. The inclusion of this instance of the Wrapper Class Object in the Collection Object ensures that the Collection Object remains active, retaining the Wrapper Class Instance in memory until the Form is closed and subsequently cleared.
The reason we need to execute Set cmd = Nothing is to avoid creating the next CmdButton Wrapper Class Instance for another Command Button on the Form without clearing the previous one from memory. Without this step, attempts to create the second instance of the Command Button Wrapper Class could result in overwriting the earlier instance in the same memory location. Thus, resetting the cmd ensures that a new instance can be created without interference with the earlier Instance of the Wrapper Class.
If we don't execute the Set cmd = Nothing, then only the last Command Button's Event will remain valid, and others will keep overwriting the earlier Instances.
Following the reset of the "cmd" object, the process of creating another instance of the Command Button Wrapper Class involves searching for an available memory area to instantiate a new instance of the Command Button Class. This ensures the proper allocation of memory for the new instance, preventing any potential interference with existing instances.
So, please don't ignore this statement. Since it is a logical issue, you may need help finding it so easily when debugging.

The Compact_Repair Form Module VBA Code.

Option Compare Database
Option Explicit

Dim Obj As New FLst_ObjInit

Private Sub Form_Load()
DoCmd.Restore
Set Obj.Ini_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set Obj = Nothing
End Sub

As customary, we have instantiated the Interface Class FLst_ObjInit in the global declaration section of the Form's Class Module. This declaration ensures that all three sets of Class Modules—Wrapper Class, Interface Class, and Form Class Module—are loaded into memory and poised for operation.

In the Form_Load() event procedure, the 'obj.Ini_Frm' property of the Interface Class is assigned the reference to the active Form object, denoted by Me. This initiates a series of actions, and within moments, the system is primed to handle programmed events and their respective functions.

I hope this utility program proves to be a valuable tool for optimizing your Access applications over an extended period, and the best part is that it comes at no cost.

The Download Link for Compact/Repair Utility is given below:

CompactingRepairing.zip

Streamlining Code Synchronized Floating POPup Form.

2024-02-14T21:35:00.014+05:30

Streamlining Form Module Code in Standalone Class Module.

Synchronized Floating Popup Form.

The article on the Synchronized Floating Popup Form was originally published in February 2009. The notable difference is that once written in the Form Module, the Event Subroutine code is now executed from the Standalone Class Module.

All events raised by the form and its controls—such as TextBoxes and Command Buttons—are now handled within the standalone class module, with their corresponding event subroutines executed outside the form module. This exemplifies a paradigm shift where Form Module VBA codes are run from the Standalone Class Module, resulting in significantly reduced VBA code compared to what is typically written in the Form Module. At this point, the form serves solely for interface design purposes.

VBA coding, code management, and debugging can now be performed independently, without needing to open the form in Design View or navigate through control event properties to access the required code in the form module. You can always find your Object group-level streamlined Event Subroutine Code in one place in the Standalone Class Module, which is like one BeforeUpdate() Event Subroutine is only needed for 25 TextBoxes on the Form, even if all 25 of them need different sets of Code. If you have already visited the earlier Episodes of this Topic, you already know it by now.

Synchronized Floating Popup Forms.

The Employee record is structured into two distinct logical sets of information. The initial part encompasses Official Information, while the subsequent part entails personal information, including details such as address and phone number. To enhance user experience, these two sets of information are displayed in two separate, independent forms. Notably, the Personal Information section is not mandated to remain visible at all times on the screen. Instead, it can be accessed and displayed dynamically by clicking the "Personal Info" command button.

Moreover, as the navigation control advances to the next record on the first Form, it triggers an immediate update of the corresponding data on the second Form, guaranteeing seamless synchronization between the two forms. This ensures that the information displayed on both forms remains consistently aligned as the user navigates through the records.

The second form can be kept from displaying on the Screen all the time by clicking on the Close Command Button. It can be displayed by selecting the Personal Info Command Button when needed.

The OnDirty and BeforeUpdate Events are enabled for all TextBoxes and ComboBoxes to safeguard the data integrity.

There are several Textboxes, two Combo boxes, and two Command Buttons on the Form. The second Form has several text boxes and a Command Button.

To achieve the desired functionality, we need three Wrapper Classes—one for TextBoxes, one for Command Buttons, and one for Combo Boxes—along with the Intermediary Class Module (Interface Class). The Interface Class is responsible for creating Wrapper Class instances, initializing them with the corresponding Object references, and saving instances dynamically in a Collection Object in memory. This approach ensures that when the events are triggered on the form, they can be captured in the respective Wrapper Classes, allowing the execution of the required Event Procedures within the Wrapper Class Instances. This modular and organized structure enhances code manageability and promotes effective event handling across different types of controls on the form.

The TextBox Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents Txt As Access.TextBox
Private tfrm As Access.Form
'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'TextBox Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
'======== Form Object Property Procedure =========
Public Property Get t_Frm() As Access.Form
    Set t_Frm = tfrm
End Property

Public Property Set t_Frm(ByRef vFrm As Access.Form)
    Set tfrm = vFrm
End Property

'======== TextBox Object Property Procedure =========
Public Property Get t_txt() As Access.TextBox
    Set t_txt = Txt
End Property

Public Property Set t_txt(ByRef vtxt As Access.TextBox)
    Set Txt = vtxt
End Property

'======== Event Subroutine =========
Private Sub txt_Dirty(cancel As Integer)
If MsgBox("Are you Editing " & Txt.Name & " Field?", vbYesNo + vbCritical, Txt.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

Private Sub txt_BeforeUpdate(cancel As Integer)
If MsgBox("Save the Changes " & Txt.Name & " Field?", vbYesNo + vbCritical, Txt.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

The TextBox Wrapper Class streamlines the process with just two Event Procedures, each containing a few lines of reusable code. This significantly simplifies the handling of all TextBoxes on both forms. Contrast this with the scenario where you'd have to repetitively write these concise lines of code for each TextBox in both Form Modules. The Wrapper Class approach promotes code efficiency and enhances maintainability by consolidating common functionality in a centralized location.

A crucial aspect worth highlighting is the utilization of the same TextBoxWrapper Class Instances for all Text Boxes across two distinct forms. This showcases the versatility of the new coding approach. This flexibility is particularly beneficial in scenarios involving one or more SubForms within the Main Form, as it allows for a unified and efficient management of TextBox events and functionality, promoting a cohesive and streamlined development process.

The Command Button Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents cmd As Access.CommandButton
Private cFrm As Access.Form
Private uFrm As Access.Form
Private strSQL As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'CommandButton Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
Public Property Get c_Frm() As Access.Form
    Set c_Frm = cFrm
End Property

Public Property Set c_Frm(ByRef vFrm As Access.Form)
    Set cFrm = vFrm
    Set uFrm = Forms("Employee_Sub")
End Property

Public Property Get c_cmd() As Access.CommandButton
    Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef vcmd As Access.CommandButton)
    Set cmd = vcmd
End Property

'====Event Subroutines====
Private Sub cmd_Click()
    Select Case cmd.Name
        Case "cmdClose"
            If MsgBox("Close the Main Form?", _
            vbYesNo + vbCritical, cmd.Name & "_Click()") = vbNo Then
                'Do Nothing
            Else
                DoCmd.Close acForm, "Employee_Sub"
                DoCmd.Close acForm, cFrm.Name
            End If
        
        Case "cmdPersonalInfo"
                strSQL = "SELECT Employees.* FROM Employees "
                strSQL = strSQL & "WHERE ([EmployeeID] = " & cFrm![EmployeeID] & ");"
                uFrm.RecordSource = strSQL
                uFrm.Requery
                uFrm.Visible = True
                cFrm.ActiveControl.SetFocus
        
        Case "cmdCloseSub"
                uFrm.Visible = False
    End Select
End Sub

Having two Command Buttons on the Main Form and an additional one on the Second Form to close it is common. Writing the Command Button Click Event Subroutines in the same Wrapper Class Module as demonstrated above streamlines the code organization. Each Command Button corresponds to a dedicated Wrapper Class Instance, and these instances are assigned their respective Control References from both forms.

Using control references as keys is crucial for the system to accurately identify the correct instance of the Wrapper Class, ensuring that the appropriate Event Subroutine is executed for each Command Button click. This approach enhances code clarity, maintainability, and reusability across different forms and controls.

The ComboBox Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents cbo As Access.ComboBox
Private bFrm As Access.Form

'-------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'-------------------------------------------------------
'CommandButton Events
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'-------------------------------------------------------
Public Property Get b_Frm() As Access.Form
    Set b_Frm = bFrm
End Property

Public Property Set b_Frm(ByRef vFrm As Access.Form)
    Set bFrm = vFrm
End Property

Public Property Get b_cbo() As Access.ComboBox
    Set b_cbo = cbo
End Property

Public Property Set b_cbo(ByRef vcbo As Access.ComboBox)
    Set cbo = vcbo
End Property

'==== ComboBox Event Subroutine ====
Private Sub cbo_Dirty(cancel As Integer)
If MsgBox("Are you Editing " & cbo.Name & " Control?", _
vbYesNo + vbCritical, cbo.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

Private Sub cbo_BeforeUpdate(cancel As Integer)
If MsgBox("Save the Changes " & cbo.Name & " Control?", _
vbYesNo + vbCritical, cbo.Name & " Dirty()") = vbNo Then
    cancel = True
End If
End Sub

There are two Combo Boxes on the Main Form. The Comboboxes are also enabled with the OnDirty() and BeforeUpdate() Event Subroutines to safeguard the data from unintentional changes or to apply changes with the User's consent.

The Interface Class Module VBA Code.

Option Compare Database
Option Explicit

Private ocmd As ClsCmdButton 'Wrapper Class
Private oTxt As ClsTextBox   'Wrapper Class
Private ocbo As ClsCombo     'Wrapper Class

Private WithEvents Frm As Access.Form 'Employees_Main
Private sFrm As Access.Form 'Employee_Sub

Private coll As New Collection
Private strSQL As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Wrapper Classes Initialization
'Author: a.p.r. pillai
'Date  : 16/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get i_Frm() As Access.Form
    Set i_Frm = Frm
End Property

Public Property Set i_Frm(ByRef vFrm As Access.Form)
    Set Frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

'Open the 2nd Form
DoCmd.OpenForm "Employee_Sub", , , , , acHidden

'Assign the Form Reference to sFrm Object
Set sFrm = Forms("Employee_Sub")

'Enable the OnCurrent Event of the Employees_Main Form
Frm.OnCurrent = EP

For Each ctl In Frm.Controls 'Employees_Main Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name '
            Case "cmdClose", "cmdPersonalInfo"
                Set ocmd = New ClsCmdButton 'Create new instance
                Set ocmd.c_Frm = Frm 'Assign Main Form Reference
                Set ocmd.c_cmd = ctl 'Pass current CommandButton Object Reference
                    ocmd.c_cmd.OnClick = EP 'Enable OnClick Event
                    coll.Add ocmd 'Add the instance to Collection Object
                Set ocmd = Nothing 'Reset Wrapper Class instance
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox
                Set oTxt.t_Frm = Frm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    coll.Add oTxt
                Set oTxt = Nothing
                
            Case "ComboBox"
                Set ocbo = New ClsCombo
                Set ocbo.b_Frm = Frm
                Set ocbo.b_cbo = ctl
                    ocbo.b_cbo.OnDirty = EP
                    ocbo.b_cbo.BeforeUpdate = EP
                    ocbo.b_cbo.BackColor = RGB(&HFF, &HF2, &H0)
                    ocbo.b_cbo.BackStyle = 0
                    coll.Add ocbo
                Set ocbo = Nothing

    End Select
Next

For Each ctl In sFrm.Controls 'Employees_Sub Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name
            Case "cmdCloseSub"
                Set ocmd = New ClsCmdButton 'Instantiate
                Set ocmd.c_Frm = sFrm
                Set ocmd.c_cmd = ctl
                    ocmd.c_cmd.OnClick = EP
                    
                    coll.Add ocmd           'Add to Collection
                Set ocmd = Nothing
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox   'Instantiate
                Set oTxt.t_Frm = sFrm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    coll.Add oTxt           'Add to Collection
                Set oTxt = Nothing
    End Select
Next

End Sub

Private Sub frm_Current()
If IsLoaded("Employee_Sub") Then
   strSQL = "SELECT Employees.* FROM Employees "
   strSQL = strSQL & "WHERE ([EmployeeID] = " & Frm![EmployeeID] & ");"
   sFrm.RecordSource = strSQL
   Frm.SetFocus
End If

Private Sub Class_Terminate()
Set Frm = Nothing
Set sFrm = Nothing
Do While coll.Count > 0
    coll.Remove 1
Loop

End Sub

The Wrapper Classes are declared as Properties of the Interface Class. Two Form Object Properties are declared to scan for Controls on Employees_Main and Employee_Sub Forms.

The Frm Object is qualified with the Keyword WithEvents to enable the OnCurrent Event of the Employees_Main Form to update the Employee_Sub Form data based on the movement of Records on the Main Form.

The Collection Object and a String Variable strSQL are Properties declared in the Global Area.

The Property Procedures for the Frm Object are declared next to receive the Main From Object Reference from the Form_Load() Event Procedure of the Employees_Main Form. After assigning the Main Form Reference to the Frm Object, the Class_Init Subroutine is called to create the Wrapper Class Instances and Initialize Procedures.

At the beginning of the Class_Init() Subroutine, the Employee_Sub Form is opened in Hidden Mode and kept in memory. The sFrm Form object is assigned the Reference of the Employee_Sub Form.

The following statement enables the Main Form's OnCurrent Event to fire the Event when the record is moved from one to the other through the Record Navigation Control:

'Enable the OnCurrent Event of the Employees_Main Form
Frm.OnCurrent = EP

There are three sets of Objects on the Employees_Main Form: TextBoxes, Command Buttons, and Combo Boxes. The Employee_Sub Form has a few TextBoxes and a single Command Button to create Wrapper Class Instances and assign their related Object References.

The following VBA Code Segment scans the Employees_Main Form for Textboxes, Command Buttons, and ComboBoxes:

For Each ctl In Frm.Controls 'Employees_Main Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name '
            Case "cmdClose", "cmdPersonalInfo"
                Set ocmd = New ClsCmdButton     'Create new instance
                Set ocmd.c_Frm = Frm            'Assign Main Form Reference
                Set ocmd.c_cmd = ctl            'Pass current CommandButton Object Reference
                    ocmd.c_cmd.OnClick = EP     'Enable OnClick Event
                    coll.Add ocmd               'Add the instance to Collection Object
                Set ocmd = Nothing              'Reset Wrapper Class instance
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox
                Set oTxt.t_Frm = Frm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    
                    oTxt.t_txt.BackColor = RGB(255, 242,0) 'Yellow Color
                    oTxt.t_txt.BackStyle = 0
                    
                    coll.Add oTxt
                Set oTxt = Nothing
                
            Case "ComboBox"
                Set ocbo = New ClsCombo
                Set ocbo.b_Frm = Frm
                Set ocbo.b_cbo = ctl
                    ocbo.b_cbo.OnDirty = EP
                    ocbo.b_cbo.BeforeUpdate = EP
                    
                    ocbo.b_cbo.BackColor = RGB(255, 242, 0) 'Yellow Color
                    ocbo.b_cbo.BackStyle = 0
                    
                    coll.Add ocbo
                Set ocbo = Nothing

    End Select
Next

The provided code segment examines the existence of Command Button, TextBox, and ComboBox controls on the Employees_Main Form. It creates instances of the corresponding Wrapper Classes, sets the Wrapper Class property values, enables the controls' OnDirty and BeforeUpdate Events, and then adds these instances to the Collection Object in memory. This systematic approach ensures that the necessary controls are properly encapsulated within their respective Wrapper Class Instances and facilitates organized event handling through the centralized Collection.

The dynamic modification of the TextBox and ComboBox controls' BackColor and BackStyle property values enhances user interaction on the form. Specifically, these properties are adjusted to highlight the background of the controls in yellow when they become active. The BackStyle property is set to Transparent, ensuring that the yellow background color is only displayed when the TextBox or ComboBox is in focus, contributing to a visually intuitive and user-friendly design.

The Employee_Sub Form Controls VBA Code Segment.

For Each ctl In sFrm.Controls 'Employees_Sub Form Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
        
          Select Case ctl.Name
            Case "cmdCloseSub"
                Set ocmd = New ClsCmdButton 'Instantiate
                Set ocmd.c_Frm = sFrm
                Set ocmd.c_cmd = ctl
                    ocmd.c_cmd.OnClick = EP
                    
                    coll.Add ocmd           'Add to Collection
                Set ocmd = Nothing
          End Select
          
            Case "TextBox"
                Set oTxt = New ClsTextBox   'Instantiate
                Set oTxt.t_Frm = sFrm
                Set oTxt.t_txt = ctl
                    oTxt.t_txt.OnDirty = EP
                    oTxt.t_txt.BeforeUpdate = EP
                    
                    oTxt.t_txt.BackColor = RGB(&HFF, &HF2, &H0)
                    oTxt.t_txt.BackStyle = 0
                    
                    coll.Add oTxt           'Add to Collection
                Set oTxt = Nothing
    End Select
Next

The second form exclusively contains TextBoxes, each equipped with OnDirty() and BeforeUpdate() Event Procedures, akin to the Main Form. If additional Event Subroutines are deemed necessary for these TextBoxes, beyond OnDirty() and BeforeUpdate(), they can be conveniently authored within the same Wrapper Class. The beauty of this approach lies in the uniqueness of references assigned to each TextBox. This ensures that the references are tied to the respective objects, enabling the system to accurately locate and execute the correct Event Procedure for each TextBox through the associated Wrapper Class Instances.

The Form_Current() Event Subroutine.

Private Sub frm_Current()
If IsLoaded("Employee_Sub") Then
   strSQL = "SELECT Employees.* FROM Employees "
   strSQL = strSQL & "WHERE ([EmployeeID] = " & Frm![EmployeeID] & ");"
   sFrm.RecordSource = strSQL
   Frm.SetFocus
End If
End Sub

Private Sub Class_Terminate()
Set Frm = Nothing
Set sFrm = Nothing
Do While coll.Count > 0
    coll.Remove 1
Loop
End Sub

When the Record Navigation Button is employed to navigate to the next or previous record on the Employees_Main Form, the Form_Current() Event is triggered and captured by the Subroutine frm_Current() provided above. In response, a SQL query is formulated using the EmployeeID value as a key to filter the data from the employee record. Subsequently, this Query is utilized as the Record Source of the second form, Employee_Sub, ensuring the synchronization of the Personal Info Data with the record currently displayed on the Employees_Main Form. This approach facilitates seamless coordination between the two forms, providing updated and synchronized information based on the selected record.

The Sub Class Terminate() Subroutine works, like the Form_Unload() Event Subroutine on the Form. When you close the Form, the Form_Unload() Event Procedure fires, if it is present on the Form before the Form is actually closed. This Subroutine clears the Forms declarations, removes all the Wrapper Class Instances from the Collection Object, and finally removes the Collection Object itself from memory.

The Employees_Main Form Module Code.

Option Compare Database
Option Explicit

Private obj As New ClsObject_Init

Private Sub Form_Load()
    Set obj.i_Frm = Me
End Sub

Private Sub Form_Unload(cancel As Integer)
    Set obj = Nothing
If IsLoaded("Employee_Sub") Then
  DoCmd.Close acForm, "Employee_Sub"
End If
End Sub

Declares the Interface Object ClsObj_Init Class Module and Instantiates it with the Object Name obj in the Global Declaration area of the Form Module.

In the Form_Load() Event Subroutine, the Form Object Me is passed to the Frm Property of ClsObj_Init Interface Class through the Property Procedure i_Frm() in this statement Set obj.i_frm = Me.

In the Form_Unload() Event Procedure, the statement Set obj = Nothing attempts to clear the ClsObj_Init Interface Class from memory. This will trigger the Sub Class_Terminate() Subroutine we discussed above.

Hope you enjoyed the new way of Coding, and your feedback is highly appreciated.

Demo Database Download

SynchronizedForms2K.zip

One TextBox and Three Wrapper Class Instances.

2024-02-01T17:26:00.012+05:30

Streamlining Event Subroutines in Standalone Class Module.

The Standalone Class Module Coding Rules overview.

One Wrapper Class Module for several objects of the same Type (E.g., TextBox) on the Form. Example: ClsTextBox.

One Event Subroutine per Event for several Objects of the same type on the Form.

Example:

Private Sub txt_AfterUpdate()
    Select Case TypeName(Ctl)
       Case "TextBox"
       
          Select Case Ctl.Name 
              Case "Text0"
                  'Code
                  
              Case "Text2","Text4","Text6"
                  'Code
                  
              Case "Text8"
                  'Code
          End Select
          
   End Select
End Sub

Wrapper Class instances are established, with an individual Instance designated for each TextBox on the form. Subsequently, each Instance is assigned its respective TextBox Reference.

Let us look at the Class_Init() Subroutine VBA Code and see how this process is initiated in the Intermediary (or Interface) Class Module - ClsObj_Init.

 Private Sub Class_Init()
 Dim Ctl As Control
 
 For Each Ctl In Frm.Controls
   Select Case TypeName(Ctl)
     Case "TextBox"
       Set txt = New ClsTextBox
       Set txt.m_frm = Frm
       Set txt.m_txt = Ctl
       
           txt.m_txt.AfterUpdate = "[Event Procedure]"
           
           Coll.Add txt
       Set txt = Nothing
   End Select
Next

The above Subroutine modifies the AfterUpdate Event Property Values with the text [Event Procedure] option at run-time.
The Enter-Key press, after typing something in the TextBox, fires the AfterUpdate Event.
If the AfterUpdate Property is assigned with a Macro or Public Function Name, then the Event will call the Macro or Function directly. The Form doesn't need a Class Module to run these two options.
As we are all aware, typically, we write one Subroutine per Event and create one Wrapper Class Instance per TextBox. However, what happens if we deviate from this convention and create three Wrapper Class Instances, with an AfterUpdate Event Subroutine, for a single TextBox (e.g., Text0) and assign all three Instances with the same Text0 Reference (the Memory Address of Text0 TextBox)?

How does the AfterUpdate Event fire from all three Instances? All of them together or one after the other?
What will happen if three different Macro Names or Function Names are assigned to the AfterUpdate Property, for all three Wrapper Class Instances, like the example Code segment shown below:
```
	For j = 1 To 3 'To create three Instances
             Set ctxt = New ClsTextBox
             Set ctxt.txt = ctl 'Text0 Reference
                 ctxt.param = j
                    
                'Macro1, Macro2, Macro3
    		 ctxt.txt.AfterUpdate = "Macro" & CStr(j) 

                 coll.Add ctxt
             Set ctxt = Nothing
        Next
```
To conduct this experiment and explore the outcomes, we require a TextBox on a Form named Text0, along with the TextBox Wrapper Class Module and the Intermediary (or Interface) Class Module to set up the necessary elements.

The Image of the Form is given below:

Wrapper Class Module: ClsTextBox VBA Code.

Option Compare Database
Option Explicit

Public WithEvents txt As Access.TextBox
Public param As Integer

Private Sub txt_AfterUpdate() 
Dim x As Variant
Dim msg As String

msg = "INSTANCE OF " & UCase(txt.Name)
Select Case param
    Case 1
        'DoCmd.RunMacro "Macro1"
        'x = DisplayText1()

        MsgBox "1st " & msg
    Case 2
        'DoCmd.RunMacro "Macro2"
        'x = DisplayText2()

        MsgBox "2nd " & msg
    Case 3
        'DoCmd.RunMacro "Macro3"
        'x = DisplayText3()

        MsgBox "3rd " & msg
End Select
End Sub

Review of Wrapper Class Code.

The TextBox Object Txt is declared with Public Scope and qualified with the Keyword WithEvents. There is another Property param also declared with Public Scope.

Following this, the Sub txt_AfterUpdate() Event procedure will execute three times consecutively. This occurs for the same event procedure but originates from three distinct Wrapper Class instances. The execution order aligns with the sequential instances creation, starting with the first instance, followed by the second, and concluding with the third.

To discern the order of Wrapper Class instance creation and execution sequence, a sequence number is passed as a parameter to the param variable. When the AfterUpdate event subroutine is executed, the number within the param variable is displayed in a message text. This approach allows us to identify from which Wrapper Class instance the message is displayed and in what order.

The Macro and Function Name demo running VBA Code lines are temporarily disabled for testing the [Event Procedure] alone.

The Intermediary or Interface Class Module ClsObj_Init VBA Code.

Option Compare Database
Option Explicit

Private ctxt As ClsTextBox
Private frm As Form

Private WithEvents cmd As CommandButton
Dim coll As New Collection

Public Property Get m_Frm() As Form
    Set m_Frm = frm
End Property

Public Property Set m_Frm(ByVal vFrm As Form)
    Set frm = vFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Dim j As Integer
Const EP = "[Event Procedure]"
    
For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            Select Case ctl.Name
                Case "Text0" 'The Text0 Object Reference.
                  For j = 1 To 3
                    Set ctxt = New ClsTextBox
                     Set ctxt.txt = ctl
                        ctxt.param = j
                        
    'ctxt.txt.AfterUpdate = "Macro" & CStr(j) 'Macro1, 2, 3
    'ctxt.txt.AfterUpdate = "=DisplayText" & CStr(j) & "()"

    ctxt.txt.AfterUpdate = "[Event Procedure]"
                        coll.Add ctxt
                    Set ctxt = Nothing
                  Next
            End Select
        Case "CommandButton"
          Select Case ctl.Name
            Case "CmdClose"
              Set cmd = frm.cmdClose
                cmd.OnClick = "[Event Procedure]"
          End Select
    End Select
 Next
End Sub

Private Sub cmd_Click()
DoCmd.Close acForm, frm.Name
End Sub

As usual, the first two lines of Code in the global declaration area, the TextBox Wrapper Class Object ctxt, and the Form object frm are declared.

A Command Button on the form requires a Click Event to close the form. To capture the event in the Interface Class Module when fired on the form, a Command Button object is declared in the global area, qualified with the keyword WithEvents. It's important to note that since there is only one Command Button on the form, handling the Click Event in the Interface Class Module can be done directly without the need to create a Wrapper Class.

A Collection object is declared to store all TextBox object instances in memory, enabling the capture of events fired on the form and the execution of the corresponding event subroutines.

When the Form is open, the Form Object is passed to the Form object's Set Property Procedure. The Object reference is assigned to the frm Property.

Next, the Class_Init() Subroutine is called.

In the For ... Next loop, the Code scans the Form for the Text0 TextBox. Once found, the inner For...Next loop is configured to run for three cycles, creating three instances of the Wrapper Class Object ctxt. All three instances are assigned the same Text0 Control's reference. It's worth noting that this can be achieved without using the For...Next loop by duplicating the code three times. However, for consistency, we adhere to the coding style employed thus far.

When the Wrapper Class instances are created, the sequence number is passed to the Property 'ctxt.param'. This number is then displayed in the MsgBox within the AfterUpdate Subroutine. This approach proves beneficial for identifying the execution order of the Event Subroutines, mirroring the sequence in which the instances are created.

If you manually create an AfterUpdate Event Subroutine in the Form Module in addition to the three instances, that Form Module Event Subroutine will execute first, followed by the Subroutines in the Wrapper Class instances. This sequence ensures that any manually added code in the Form Module takes precedence over the dynamically created instances.

As you have seen in the AfterUpdate Event Subroutine, we can check the sequence number in the param Property (see the Code segment given below), and based on its sequential order, it is possible to call three different Sets of Programs when a single AfterUpdate or similar Event fires.

msg = "INSTANCE OF " & UCase(txt.Name)
Select Case param
    Case 1
        'DoCmd.RunMacro "Macro1"
        'x = DisplayText1()

        MsgBox "1st " & msg
    Case 2
        'DoCmd.RunMacro "Macro2"
        'x = DisplayText2()

        MsgBox "2nd " & msg
    Case 3
        'DoCmd.RunMacro "Macro3"
        'x = DisplayText3()

        MsgBox "3rd " & msg
End Select

The test run of the Event Subroutine Image (message from the first Instance) is given below:

The provided screenshot captures the moment when the message is displayed from the AfterUpdate() Event Subroutine, indicating that the message originates from the first instance of the ClsTextBox Wrapper Class. Subsequently, two similar messages follow, each indicating the 2nd and 3rd instances, respectively.

Experiments with Macro Names: Macro1, Macro2, and Macro3

In the upcoming experiment, we will replace the text [Event Procedure] with the Macro names Macro1, Macro2, and Macro3 to trigger the AfterUpdate Event. It's important to note that no alterations will be made to the TextBox Wrapper Class VBA Code. Below is the modified code for the Class_Init() Subroutine in the Interface Module for your reference.

Private Sub Class_Init()
Dim ctl As Control
Dim j As Integer
Const EP = "[Event Procedure]"
    
For Each ctl In frm.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            Select Case ctl.Name
                Case "Text0"
                  For j = 1 To 3
                    Set ctxt = New ClsTextBox
                     Set ctxt.txt = ctl
                        ctxt.param = j
                        
        'Macro1, Macro2, Macro3              
    	ctxt.txt.AfterUpdate = "Macro" & CStr(j)
        
                       coll.Add ctxt
                    Set ctxt = Nothing
                  Next
            End Select
        Case "CommandButton"
          Select Case ctl.Name
            Case "CmdClose"
              Set cmd = frm.cmdClose
                cmd.OnClick = "[Event Procedure]"
          End Select
    End Select
 Next
End Sub

All three Macros have a Message Box Function that displays a message with the Macro Version numbers 1, 2, and 3, as shown below:

In the Initializing Class_Init() Subroutine, the AfterUpdate Property is assigned with the Macro Names: Macro1, Macro2, and Macro3, as we normally do with the [Event Procedure] Option.

Following the modifications in the VBA code, input some text into the TextBox and press the Enter key to trigger the AfterUpdate event. Subsequently, you will be greeted with a message from Macro3 exclusively. As previously emphasized, it's crucial to note that the Form Class Module or the Wrapper Class does not play a role in the invocation of the macro or function from the AfterUpdate or any other event property.

Running Public Functions: =DisplayText1(), =DisplayText2(), =DisplayText3().

It's worth noting that there are three functions in the standard module bearing the names mentioned above. Each of these functions utilizes the MsgBox function to display text, identifying the sequence number as depicted in their respective names.

If you substitute the AfterUpdate event-enabling line in the Class_Init() subroutine with the provided line of code and subsequently open the form, triggering the AfterUpdate event will reveal that the displayed message emanates solely from the function DisplayText3().

ctxt.txt.AfterUpdate = "=DisplayText" & CStr(j) & "()"

In contrast to the [Event Procedure] option, which invokes the RaiseEvent action, the macro and function name coding pertains to the direct modification of the AfterUpdate Event Property of the TextBox on the Property Sheet. This manual alteration involves replacing the existing name with three different names successively, with the final one prevailing.

How to Run Macros or Functions.

Indeed, the experimental approach undertaken served as an extraordinary demonstration, underscoring the crucial point that macro or function names coded in the Event Property are executed directly by the system. The involvement of the Wrapper Class Instance is entirely bypassed in this process. Whether the names are manually written in the Event Property or scripted through the Class_Init() Subroutine, the modifications are consistently made directly to the TextBox Property.

To alleviate potential confusion, a recommended approach is to consistently opt for the [Event Procedure] option and then call the macro or function, if needed, from within the TextBox Wrapper Class Instance-based subroutine. An illustrative example is provided below:

Private Sub txt_AfterUpdate() 
Dim x As Variant

Select Case txt.Name
    Case "Text0"
        'DoCmd.RunMacro "Macro1" ' Run Macro
        'x = DisplayText1()      ' Run Function

        MsgBox "TextBox" & txt.Name
End Select

By adopting this method, clarity is enhanced, and the direct execution of macros or functions from the Event Property remains seamless within the designated Textbox Wrapper Class Instance.

Demo Database Download

MultipleInstances.zip

The Event Firing Mechanism in Access Objects

2024-01-20T20:42:00.006+05:30

Streamlining Event Subroutine Code in Standalone Class Module.

How Does the Event Firing Mechanism Work within Access Objects?

This topic was briefly touched on during the Presentation of Streamlining Form Module Code in the Standalone Class Module for Access User Groups (Europe) Chapter.

The Event-related Key Words: Event, RaiseEvent, and WithEvents.

Event - used to define an Event.
RaiseEvent - to Invoke the Event.
WithEvents - to capture the fired Event and execute the Event Subroutine Code.

In the preceding articles, we gained insights into the utilization of Event-related Keywords and crafted Event Subroutines within Standalone Class Modules rather than within the Form Module. Notably, the Event and WithEvents keywords were prominently featured in the Object Browser, as illustrated below:

Right-click to open Large Image in New Tab/Window.

However, the RaiseEvent serves as an internal event-firing mechanism that accommodates multiple options within a dedicated event-related property. This Event is initiated from within the Class Object, functioning as a system program. It assesses the specified option in the event property and executes the selected choice, be it a macro, function (user-defined or built-in), or the text [Event Procedure]. This, in turn, triggers the RaiseEvent, like the functionality of the Call Statement in VBA.

The following Link gives the details about the RaiseEvent Statement: https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/raiseevent-statement

The authentic Event-firing mechanism is an internal system program intricately linked to each event of an object within the Access System. For instance, the AfterUpdate Event encompasses an AfterUpdateMacro, typically concealed from the Object Browser Window. To reveal it, one can simply right-click and select the option 'Show Hidden Members'. Analogously, other Object Events, such as CommandButton Click, feature the OnClick Event property to specify the execution option. Furthermore, there's the OnClickMacro, which evaluates the provided value in the OnClick Property, facilitating the execution of the designated option.

Assumptions Based on Observation.

Upon scrutinizing the execution pattern of the specified option within the Event Property, I found it worthwhile to attempt to create a straightforward subroutine that emulates the methodology employed by the Event mechanism. This endeavor aims to replicate the process by which the event mechanism executes the designated option specified in the Property Sheet.

An interesting observation emerges: when a macro name or function name is specified in the Event Property, it triggers the execution of the designated macro or built-in function, as well as user-defined functions in a standard module. Notably, for these two options, there is no requisite attachment of a Class Module to the Form, and the 'Has Module' Property of the Form can be set to False.

However, opting for the [Event Procedure] choice in the Event Property triggers an automatic attachment of a Class Module to the Form. Simultaneously, an empty Event Subroutine Stub is seamlessly added to the Form Module, serving as a canvas to inscribe the necessary subroutine code within this newly associated Class Module.

The observed behavior of the Event running mechanism implies that when a value is entered into the Event Property in the Property Sheet, the system intelligently identifies it. Each of the three options—Macro, Expression, or the text [Event Procedure]—bears distinctive markers, enabling the system to recognize and execute the corresponding event-related action accordingly. This nuanced recognition ensures that the system interprets and responds to the specified option accurately.

Expression: Should start with an equal symbol (=) character followed by the Function Name and Parameters, if any, like =MsgBox("Hello World") or a User-Defined Function in the Standard Module.

Building upon these assumptions, I've crafted a subroutine designed to emulate this behavior when one of the three aforementioned options—Macro, Expression, or [Event Procedure]—is provided in a TextBox Control.

The Event Running Form Image is given below:

Right-click to open Large Image in New Tab/Window.

The above Form is divided into two Parts:

The upper portion of the form, delineated by the thick horizontal black line in the middle, serves as our experimental ground for exploring the event execution method. Here, we endeavor to unravel the intricacies of the actual event running mechanism within the Access System.
In the Section below the horizontal line, we will run the same Event Options as we normally do in the AfterUpdate Property of a TextBox.

Within the initial section, a ListBox offers a range of options that can be swiftly selected by a simple click. Upon selection, the chosen option promptly populates the Text2 TextBox Control above. Analogous to the AfterUpdate Event Property in the TextBox's Property Sheet, the specified option in the TextBox Control instantaneously executes within our Event Subroutine AfterUpdateMac().

The Event running Subroutine AfterUpdateMac() is written within the Standalone Class Module ClsAfterUpdateMacro.

The ClsAfterUpdateMacro Class Module VBA Code.

The Class Module with the Subroutine AfterUpdateMac() VBA Code is given below:

Option Compare Database
Option Explicit

'User-Defined Event
Public Event AfterUpdat(ByVal txt As String)
Private After_Update As String
'Options: Macro,Function,"[Event Procedure]"

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'AfterUpdateMac() Event Processing Subroutine
'Author: a.p.r. pillai
'Date  : 19/01/2024
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get OnAfterUpdate() As String
 OnAfterUpdate = After_Update
End Property

Public Property Let OnAfterUpdate(ByVal vNewValue As String)
 After_Update = vNewValue
 
 Call AfterUpdateMac
End Property

Private Sub AfterUpdateMac()
'Evaluate the given option
'and Run the Event action
Dim opt As String
Dim vx As Variant

On Error GoTo AfterUpdateMac_Err

opt = Nz(After_Update, "")

If Len(opt) = 0 Then
    Exit Sub
ElseIf UCase(opt) = "[EVENT PROCEDURE]" Then
    'RaiseEvent: Call Event Subroutine
    RaiseEvent AfterUpdat("RaiseEvent MESSAGE TEXT")
ElseIf Left(opt, 1) = "=" Then
    'Expression
    opt = Mid(opt, 2)
    vx = Eval(opt)
Else
    'Run Macro
    DoCmd.RunMacro opt
End If

AfterUpdateMac_Exit:
Exit Sub

AfterUpdateMac_Err:
MsgBox Err & ": " & Err.Description, , "AfterUpdateMac_Err()"
Resume AfterUpdateMac_Exit
End Sub

Review of the Class Module Code.

In the Global declaration area, an Event is defined with the name AfterUpdat(ByVal txt As String). The letter e in AfterUpdate is omitted intentionally. Another Property After_Update As String is also declared for inserting the Event running option, analogous to the AfterUpdate Property of the TextBox.

Then, the Get, Let Property Procedures to get the selected option from the Form and pass it on to the AfterUpdateMac() to execute the Option. The AfterUpdateMac() is trying to mimic the action of the AfterUpdateMacro hidden Property/Procedure of the TextBox we saw in the Object Browser Image given at the top of this Page.

The options that we can normally insert into an Event Property are given in a ListBox.

A Macro with the name Macro1
The Function/Expression =DisplayText() to call the Function in the Standard Module
The String [Event Procedure] to call the declared Event Subroutine in the Form Module.
Other built-in Functions like MsgBox() and InputBox().

By clicking on an option, you effectively insert it into the After_Update Property and activate a process within the Class Module that evaluates and executes the chosen option.

The AfterUpdateMac() Subroutine VBA Code.

Let us have a closer look at the AfterUpdateMac() Subroutine Code.

Private Sub AfterUpdateMac()
'Evaluate the given option
'and Run the Event action
Dim opt As String
Dim vx As Variant

On Error GoTo AfterUpdateMac_Err

opt = Nz(After_Update, "")

If Len(opt) = 0 Then
    Exit Sub
ElseIf UCase(opt) = "[EVENT PROCEDURE]" Then
    'RaiseEvent: Call Event Subroutine
    RaiseEvent AfterUpdat("RaiseEvent MESSAGE TEXT")
ElseIf Left(opt, 1) = "=" Then
    'Expression
    opt = Mid(opt, 2)
    vx = Eval(opt)
Else
    'Run Macro
    DoCmd.RunMacro opt
End If

AfterUpdateMac_Exit:
Exit Sub

AfterUpdateMac_Err:
MsgBox Err & ": " & Err.Description, , "AfterUpdateMac_Err()"
Resume AfterUpdateMac_Exit
End Sub

Within the subroutine, two local variables, opt and vx, are declared. The selected option, inserted into the Text2 TextBox Control on the form, is assigned to the After_Update Property declared in the global area of the Class Module. The statement opt = Nz(After_Update, "") checks whether the After_Update Property contains any value. If it does not, the subroutine gracefully exits.

Should the received value be the text [Event Procedure], the Subroutine proceeds to trigger the user-defined Event AfterUpdate() with some sample text parameter. This event is captured in the Form Module, subsequently displaying the parameter text in a MessageBox.

In the scenario where the opt variable contains an expression (Note: an expression commences with an '=' symbol), a check is made for the presence of the equal symbol as the first character. If detected, it is presumed to be a function or a valid expression. The expression is then passed to the Eval() function after removing the '=' symbol.

If the value received in the After_Update Property doesn't satisfy any of the aforementioned criteria, it is assumed to be a macro name. Subsequently, the macro is executed using the DoCmd.RunMacro command.

If any Error is encountered, it shows an Error Message and exits from the Program.

The Form Module Code is listed below:

Option Compare Database
Option Explicit

Private WithEvents C1 As ClsAfterUpdateMacro

Private Sub Form_Load()
Set C1 = New ClsAfterUpdateMacro
End Sub

Private Sub cmdClose_Click()
DoCmd.Close
End Sub

Private Sub List0_Click()
    Me.Text2.Value = List0
    C1.OnAfterUpdate = Me![Text2]
End Sub

'UserDefined Event Message
Private Sub C1_AfterUpdat(ByVal otxt As String)
    MsgBox otxt
End Sub

'This is the Normal Procedure
'Executed by Access System.
Private Sub Text27_AfterUpdate()
    MsgBox "AfterUpdate Event Subroutine Fired."
End Sub

The Form Module Code Review.

The ClsAfterUpdateMacro Class is declared with the Object name C1 in the Global declaration area.

In the Form_Load() Event Subroutine, the C1 Object is instantiated and loaded into memory.

In the List0_Click() Event Procedure, the selected ListBox option is assigned to the After_Update Property through the C1.OnAfterUpdate Property Procedure.

The following code segment represents the subsequent subroutine that captures the AfterUpdateMac() Event when triggered from the Class Module using the RaiseEvent action, specifically when the option selected from the ListBox is [Event Procedure].

'UserDefined Event Subroutine
Private Sub C1_AfterUpdat(ByVal otxt As String)
    MsgBox otxt
End Sub

This is used for the second part of this experiment for the Normal Form Module Coding and Event firing from the Access System.

'This is the Normal Procedure
'Executed by Access System.
Private Sub Text27_AfterUpdate()
    MsgBox "AfterUpdate Event Subroutine Fired."
End Sub

The Second Part of the Form.

In the Second part of the Form, the same set of Options is typed in a Label Control so that when you are on the Form Design View, you can highlight and copy the required option from the Label Control and paste it into the AfterUpdate Event Property of the Text27 TextBox Control. This is easier than typing them correctly in the AfterUpdate Property, without errors.

Then save the Form and open it in Normal View.

Type at least one character in the TextBox and Press Enter-Key to fire the AfterUpdate Event for the option inserted into the Property of TextBox Text27.

The AfterUpdate() Event Fires at this point, depending on the option given in the Property, and executes the action as we saw it in our own earlier experiment.

Event Properties and their related Macros.

Right-click to open Large Image in New Tab/Window.

As depicted in the Object Browser image provided above, the left panel highlights the CommandButton Class selection, while the right panel showcases its event properties, including the concealed ones. Notably, all event option-setting properties are presented with an "On" prefix appended to the event name, such as OnClick. Beneath each of these properties, there exists another property or procedure bearing the same name, suffixed with the term "Macro," such as OnClickMacro. This signifies the internal program responsible for detecting the option entered within the OnClick property and subsequently executing the specified option.

It's highly plausible that these additional procedures attached to the event properties, matching their names with the "Macro" suffix, encapsulate a code structure similar to the one we experimented with in the initial section. The presence of analogous naming conventions suggests a consistent pattern in the internal program's structure, further affirming the feasibility of such a code structure.

The Demo Database with the above VBA Code and Form is attached for running your own experiments.

0_RaiseEvent2.zip

Streamlining Form Module Code Presentation

2024-01-13T23:41:00.020+05:30

Streamlining Form Module Code in Standalone Class Module.

On January 3, 2024, I presented a concise overview of the intricate topic: "Streamlining Form Module Code in Standalone Class Module" for the Access User Groups (Europe) Chapter. https://accessusergroups.org/europe/ .

https://youtu.be/AjvjN3h1ipY

The YouTube subtitles are available in eleven languages: Danish, Dutch, English, French, German, Italian, Spanish, Hindi, Malayalam, Bangla (India), and English (Autogenerated). Choose your preferred language subtitles from the Settings Menu. Experience the video, packed with technical details, all conveniently in one place. YouTube.com

PS: The Subtitle Translation may not be accurate.

Download Demo Database

Streamline7.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Numbers to Words Converter

2023-12-03T12:31:00.014+05:30

Numbers to Words Converter.

While Microsoft Word Mail Merge provides a straightforward way to convert numbers into words, this functionality is not directly available in MS Access. To bridge this gap, we developed a versatile function that can be used wherever required—whether in a Form TextBox control, Report summary totals, printed invoices, or any other context. Simply call the CardText() function with the desired number, and it will return the corresponding words for display. It’s that simple.

The Main Demo Form Image is given below:

Right-click to open Large Image in New Tab/Window.

The Demo Form in Design View.

Right-click to open Large Image in New Tab/Window.

Sample Report Image. The Group-level Subtotal Amount is printed in Words.

Right-click to open Large Image in New Tab/Window.

The CardText() Function VBA Code Listing.

Option Compare Database
Option Explicit

Public Function CardText(ByVal inNumber As Double, Optional ByVal precision As Integer = 2) As String
'------------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : December 2008/2023
'URL    : www.msaccesstips.com
'Version: 2.0
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------------
Dim ctu, ctt, bmth
Dim strNum As String, j As Integer, k As Integer, fmt As String
Dim h As Integer, xten As Integer, yten As Integer
Dim cardseg(1 To 4) As String, txt As String, d As String, txt2 As String
Dim locn As Integer, xfract As String, xhundred As String
Dim xctu As String, xctt As String, xbmth As String

On Error GoTo CardText_Err

strNum = Trim(Str(inNumber))
locn = InStr(1, strNum, ".")
'Check Decimal Places and rounding
If locn > 0 Then
  xfract = Mid(strNum, locn + 1)
 strNum = Left(strNum, locn - 1)
    If precision > 0 Then
        If Len(xfract) < precision Then
            xfract = xfract & String(precision - Len(xfract), "0")
        ElseIf Len(xfract) > precision Then
            xfract = Format(Int(Val(Left(xfract, precision + 1)) / 10 + 0.5), String(precision, "0"))
        End If
        xfract = IIf(Val(xfract) > 0, xfract & "/" & 10 ^ precision, "")
    Else
        strNum = Val(strNum) + Int(Val("." & xfract) + 0.5)
        xfract = ""
    End If
End If

h = Len(strNum)
If h > 12 Then
'if more than 12 digits take only 12 (max. 999 Billion)
'extra value will get truncated from left.
   strNum = Right(strNum, 12)
Else
   strNum = String(12 - h, "0") & strNum
End If

GoSub initSection

txt2 = ""
For j = 1 To 4
    If Val(cardseg(j)) = 0 Then
       GoTo NextStep
    End If
    txt = ""
    For k = 3 To 1 Step -1
      Select Case k
       Case 3
            xten = Val(Mid(cardseg(j), k - 1, 1))
            If xten = 1 Then
                txt = ctu(10 + Val(Mid(cardseg(j), k, 1)))
            Else
                txt = ctt(xten) & ctu(Val(Mid(cardseg(j), k, 1)))
            End If
        Case 1
            yten = Val(Mid(cardseg(j), k, 1))
            xhundred = ctu(yten) & IIf(yten > 0, bmth(1), "") & txt
            Select Case j
                Case 2
                      d = bmth(2)
                Case 3
                    d = bmth(3)
                Case 4
                    d = bmth(4)
            End Select
            txt2 = xhundred & d & txt2
    End Select
   Next
NextStep:
Next

If Len(txt2) = 0 And Len(xfract) > 0 Then
    txt2 = xfract & " only. "
ElseIf Len(txt2) = 0 And Len(xfract) = 0 Then
    txt2 = ""
Else
  txt2 = txt2 & IIf(Len(xfract) > 0, " and " & xfract, "") & " only."
End If

CardText = txt2

CardText_Exit:
Exit Function

initSection:
'Units to 19
xctu = ", One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven, Twelve,"
xctu = xctu & " Thirteen, Fourteen, Fifteen, Sixteen, Seventeen, Eighteen, Nineteen"
ctu = Split(xctu, ",")

'Tens
xctt = ", Ten, Twenty, Thirty, Fourty, Fifty, Sixty, Seventy, Eighty, Ninety"
ctt = Split(xctt, ",")

xbmth = ", Hundred, Thousand, Million, Billion"
bmth = Split(xbmth, ",")
k = 4
For j = 1 To 10 Step 3
    cardseg(k) = Mid(strNum, j, 3)
    k = k - 1
Next
Return

CardText_Err:
CardText = ""
MsgBox Err.Description, , "CardText()"
Resume CardText_Exit
End Function

The CardText() function, first written and published in January 2009, accepts two parameters. The initial parameter should be either a Decimal Number or a valid expression that resolves to a Decimal Number. The second parameter determines the precision of decimal digits during the rounding process of the fractional part of the value. Notably, the second parameter is optional and already seeded with a default value of 2. The precision setting can be modified when invoking the CardText() function to align with specific requirements.

How to Run the Function on the Form.

Upon entering a numeric value in the first TextBox, you can execute the CardText() function by pressing the Enter key or by clicking on the Show Command Button. This operation converts the entered number into words and subsequently presents it in the Label Control situated below.

In addition to inputting a straightforward numeric value, you have the flexibility to compose an expression for calculation purposes. The CardText() function processes this expression, and the resulting value is transformed into words for display. A sample expression is demonstrated below:

((625*25+0.75)*0.80)

There are two Command Buttons. One to run the Function and the other to close the Form. The Label Control displays the entered Number in Words. A simple interface allows you to enter the required parameters and call the function seamlessly.

To illustrate the straightforward application of the CardText() function, two TextBox Controls have been incorporated beneath the Close Command Button. Specifically named "Calc," the first TextBox is unbound. Users can input a numeric value into this TextBox. The adjacent TextBox on the right side features an expression: "=CardText([Calc])." This expression employs the CardText() function to convert the value entered into the "Calc" TextBox, presenting it in words within the same TextBox on the right side. This intuitive setup demonstrates the seamless integration of the CardText() function for converting numeric inputs into their textual representations.

Preparing for the Streamlining VBA Code Procedure.

Only one TextBox has the AfterUpdate Event. When fired, it simply calls the Command Button Click Event to take over the task of validating the value entered into the TextBox and to run the CardText() Function.

Given that the form boasts a straightforward interface with minimal events to manage, the streamlining procedure allows for handling these uncomplicated event procedures within the intermediary class module. Consequently, there is no imperative need for wrapper classes. This simplifies the structure and enhances efficiency by consolidating the handling of basic events directly within the intermediary class module, eliminating the necessity for additional layers of abstraction. This approach streamlines the code and contributes to a more concise and manageable implementation.

We need only one Instance of the TextBox Control and Instances of two Command Buttons with different Names in the Intermediary Class Module. All three Object Instances are declared with the keyword WithEvents so that we can write their Event Procedures in the Card_ObjInit() Class.

In this particular scenario, opting for object-level Wrapper Classes might entail a more extensive VBA codebase to handle events. Following the prescribed guidelines would necessitate Wrapper Classes, particularly for the Command Buttons. Additionally, the use of a Collection object becomes imperative to keep the instances of wrapper classes alive in memory, ensuring the capture and execution of event procedures.

However, considering the simplicity of the form interface and the limited number of events to manage, this approach may introduce unnecessary resource overhead. If the streamlined solution in the intermediary class module proves sufficient for handling these events, it can lead to a more resource-efficient implementation. This decision should be based on a balance between adhering to coding standards and optimizing resource usage for the specific requirements of the form.

Therefore, in this case, we decided to go along with managing everything in the Card_ObjInit Class Module itself.

The Card_ObjInit Wrapper Class.

The Card_ObjInit Class, which is a Wrapper Class, VBA Code is listed below.

Option Compare Database
Option Explicit

Private WithEvents txt As Access.TextBox
Private WithEvents cmdS As Access.CommandButton
Private WithEvents cmdE As Access.CommandButton
Private frm As Access.Form

Public Property Get m_Frm() As Access.Form
    Set m_Frm = frm
End Property

Public Property Set m_Frm(ByRef vfrm As Access.Form)
    Set frm = vfrm
    
    Call Class_Init

End Property

Private Sub Class_Init()
Const EP = "[Event Procedure]"

Set cmdS = frm.cmdResult
    cmdS.OnClick = EP
Set cmdE = frm.cmdClose
    cmdE.OnClick = EP
Set txt = frm.Amt
    txt.AfterUpdate = EP
End Sub

Private Sub cmdE_Click()
If MsgBox("Close the Form? ", vbYesNo + vbQuestion, "CmdClose_Click()") = vbYes Then
    DoCmd.Close acForm, frm.Name
End If
End Sub

Private Sub txt_AfterUpdate()
 Call cmdS_Click
End Sub

Private Sub cmdS_Click()
Dim tx As Variant
Dim t As Variant
Dim ctxt As String
Dim Rounding As Integer
Dim dblResult As Double
Dim msg As String
Dim fmt As String

On Error GoTo cmdResult_Click_Err
tx = frm!Amt
t = Replace(tx, ",", "")
tx = t
Rounding = frm!RoundTo
fmt = "#,##0." & String(Rounding, "0")
dblResult = Eval(tx)

If dblResult > (10 ^ 12 - 1) Then
  msg = "Value: " & dblResult & " Exceeds permissible limit."
  MsgBox msg, , "cmdResult_Click()"
Else

frm!Amt = Format(dblResult, fmt)

    ctxt = CardText(dblResult, Rounding)
    frm!Result.Caption = ctxt
End If

cmdResult_Click_Exit:
Exit Sub

cmdResult_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdResult_Click()"
Resume cmdResult_Click_Exit
End Sub

The Intermediary Class Module.

At the global declaration area, the TextBox instance is defined with the object name txt, and two Command Button Control instances, cmdS and cmdE, are also declared. Each of these instances is qualified with the 'WithEvents' keyword, empowering them to capture events triggered on the form.

At the onset of the Class_Init() Subroutine, the cmdS Command Button object, labeled Show, is linked to the cmdResult Command Button through the assignment. Simultaneously, the cmdE Command Button object is associated with the cmdClose Command Button. Both of these Command Button objects have their OnClick() events enabled. Additionally, the txt object is connected to the Amt TextBox, and its AfterUpdate event is activated.

The cmdE Click Event Subroutine Closes the Main Form.

In the cmdS Click Event Procedure, the entered value is validated, and the CardText() Function is invoked to convert the number to words. The resulting output is then displayed in the Label Control on the Form. If the input is an expression rather than a direct number, it is first evaluated to a number before calling the CardText() Function.

The AfterUpdate () Event of the Amt TextBox calls the cmdS_Click() Event Subroutine to execute the validation check and to call the CardText() Public Function.

Demo Database Download Link.

CardText V2.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Event Procedures RGBColor Wizard

2023-11-22T17:51:00.006+05:30

RGB Color Wizard.

Create your own RGB Color Palette for Form Design.

This special episode focuses on streamlining Form Module code. In our RGB Color Wizard, we use an ActiveX ScrollBar control. It is important to note that ActiveX controls—such as ScrollBars, Sliders, TreeView, and ListView—cannot be instantiated within a standalone class module. As a result, all event procedures for these controls must be written directly in the Form Module.

In this example, three ScrollBar controls are used to represent the Red, Green, and Blue color values, each ranging from 0 to 255. Together, these values combine to generate a full RGB spectrum, logically offering the capability to produce up to 16.7 million distinct colors.

The RGB Color Wizard Image is given below.

Let us take a look at the User Interface of the Color Wizard.

Right-click to open Large Image in New Tab/Window.

The Wizard Controls.

To the left of the scrollbars, three TextBox controls are positioned. As you move the scrollbar slider left or right, the corresponding color value (ranging from 0 to 255) is displayed in the adjacent TextBox. You can also manually enter numeric values into these TextBoxes to define a specific RGB color.

On the right side of the scrollbars, three Label controls display the intensity of the selected Red, Green, and Blue values, visually resembling a bar graph. The RGB() function then combines the three values to generate the final color, which is prominently shown in the large rectangle control below.

When you’re satisfied with the generated color, click the RGB Color rectangle to select it. Next, choose one of the 25 color boxes to save the new color—this action replaces the existing color in that box with your selection. The corresponding RGB value is also displayed in the RGBColor TextBox located beneath the color box grid.

You can store and maintain a maximum of 25 colors at a time. To apply a saved color to a control—such as a TextBox or Label—for properties like ForeColor, BackColor, or BorderColor, simply highlight the value in the RGB Color TextBox and copy-paste it into the desired property.

For convenience, you can also copy the RGB number directly to the Clipboard by clicking the Label control labeled ‘Copy to Clipboard’ beneath the RGB Color TextBox. Once copied, the RGB value can be pasted wherever needed.

The Form Module Code with the ActiveX Control's OnChange() Event Procedures is given below.

Option Compare Database
Option Explicit

Private CWiz As CWiz_ObjInit 'Intermediary Class

Const GraphFactor = (1 / 255) * 1440 'The Color Graph Width is 1 inch
Dim intR As Long, intG As Long, intB As Long
Dim cdb As Database, doc As Document

Private Sub Form_Load()

Set CWiz = New CWiz_ObjInit 'Instantiate CWiz_ObjInit Class
Set CWiz.o_Frm = Me 'Assign the Form object to its Property

End Sub

Private Sub form_Unload(Cancel As Integer)
    Set CWiz = Nothing
End Sub

'ActiveX Control
Private Sub Ctl_B_Change() 'Blue Color ScrollBar Control
Set cdb = CurrentDb
Set doc = cdb.Containers("Forms").Documents("ColorPalette")

intB = Ctl_B.Value
With Me
    ![BN] = intB
    .B.Width = GraphFactor * intB
    .B.BackColor = RGB(0, 0, intB)
    .Color.BackColor = RGB(intR, intG, intB)
    .RGBColor = .Color.BackColor

'Save RGBColor and BN TextBoxes contents in Form Custom Properties
doc.Properties("RGBColor").Value = .Color.BackColor
doc.Properties("BN").Value = intB

    .Controls("Color").SpecialEffect = 0
    .CheckBox.Value = False
End With
End Sub

'ActiveX Control
Private Sub Ctl_G_Change()
Set cdb = CurrentDb
Set doc = cdb.Containers("Forms").Documents("ColorPalette")

intG = Me.Ctl_G.Value

With Me
    intG = .Ctl_G.Value
    ![GN] = intG
    .G.Width = GraphFactor * intG
    .G.BackColor = RGB(0, intG, 0)
    .Color.BackColor = RGB(intR, intG, intB)
    .RGBColor = Color.BackColor

doc.Properties("RGBColor").Value = .Color.BackColor
doc.Properties("GN").Value = intG

    .Controls("Color").SpecialEffect = 0
    .CheckBox.Value = False
End With

End Sub

'ActiveX Control
Private Sub Ctl_R_Change()
Set cdb = CurrentDb
Set doc = cdb.Containers("Forms").Documents("ColorPalette")

intR = Me.Ctl_R.Value
With Me
    ![RN] = intR
    .R.Width = GraphFactor * intR
    .R.BackColor = RGB(intR, 0, 0)
    .Color.BackColor = RGB(intR, intG, intB)
    .RGBColor = Color.BackColor

doc.Properties("RGBColor").Value = .Color.BackColor
doc.Properties("RN").Value = intR

    .Controls("Color").SpecialEffect = 0
    .CheckBox.Value = False
End With
End Sub

The ScrollBar Controls.

The three ScrollBars, named Ctl_R, Ctl_G, and Ctl_B, correspond to the Red, Green, and Blue colors. When the slider control on each is moved to adjust the color numbers within the range of 0 to 255, the Change Event is triggered. This event records these actions, updating other related controls, such as the TextBox content on the left side. Additionally, it increases the width of the label controls, dynamically displaying color variations based on the selected color number range.

Additionally, the Change event dynamically updates both the RGB color shown in the large rectangular Label control and the corresponding RGB color value displayed in the TextBox beneath the Colors Grid.

Since we cannot create an instance of the ScrollBar ActiveX Control in the standalone Class Module, we are forced to write the Change Event Subroutines in the Form's Class Module.

The ColorWizard and Run-Time Data.

Typically, changes to a control’s ForeColor, BackColor, or BorderColor are made in the Form’s Design View. After updating these property values and saving the Form, the modifications are preserved. The next time the Form is opened, it will display the updated colors applied during design.

With the RGB Color Wizard, however, we modify control properties directly in Form View. Changes made in this mode are temporary—they are not automatically saved and will be lost once the form is closed. A practical solution is to store these settings in a table, so they can be reloaded and applied the next time the form is opened.

Contrary to the conventional approach of using tables for everything, we're opting for a different method. In this case, we'll save the entire data within the form itself. While not a novel concept, this method is rarely employed due to its complexity. Specifically, we'll store the data in the form's custom-made properties, akin to the Tag property of a form or control. Creating these properties with VBA programs is possible, although the route taken for this process is somewhat uncommon.

You can see how these Custom Properties are addressed for storing/retrieving data in them. For an introduction to this method, visit this Link: Saving Data on Forms, Not in a Table to see a simple, practical use of this method.

To preserve data from the ColorGrid, Text Boxes, and other controls during changes or when closing, we implemented custom properties to store this information.

The saving of values to all custom properties occurs when the form is closed. Upon reopening the form, these values are read from the custom properties and displayed on the corresponding controls. These two event procedures are implemented in the CWiz_ObjInit Class Module.

Regarding the ScrollBar Change Event Subroutine, pay attention to the subsequent lines responsible for updating custom properties and the method employed to address and store values into them:

Set cdb = CurrentDb
Set doc = cdb.Containers("Forms").Documents("ColorPalette")
.
.
.
doc.Properties("RGBColor").Value = .Color.BackColor
doc.Properties("BN").Value = intB
.

Before saving the values into the Custom Properties, we must create the Properties on the Form. This is a one-time exercise.

Sample Custom Property Management VBA Code.

Let us see an example of creating a Custom Property to save an Employee's Name in Form1. Sample VBA Code is given below:

'Create a Custom Property in Form1
Private Sub CreateProperty()
Dim db As Database
Dim doc As Document
Dim prp As Property

Set db = CurrentDb
Set doc = db.Containers("Forms").Documents("Form1")

Set prp = doc.CreateProperty("EmpName", dbText, "SampleText")

doc.Properties.Append prp

Set prp = Nothing
Set doc = Nothing
Set db = Nothing

End Sub

'Assign a value to Custom Property in Form1
Private Sub AssignPropertyValue()

Dim db As Database
Dim doc As Document

Set db = CurrentDb
Set doc = db.Containers("Forms").Documents("Form1")
    doc.Properties("EmpName").Value = "Michael Colins"

Set doc = Nothing
Set db = Nothing

End Sub

'Create a Custom Property in Form1
Private Sub ReadPropertyValue()

Dim db As Database
Dim doc As Document
Dim strName As String

Set db = CurrentDb
Set doc = db.Containers("Forms").Documents("Form1")
  strName = doc.Properties("EmpName").Value
  MsgBox "Name: " & UCase(strName)

Set doc = Nothing
Set db = Nothing

End Sub

'Create a Custom Property in Form1
Private Sub DeleteProperty()

Dim db As Database
Dim doc As Document

Set db = CurrentDb
Set doc = db.Containers("Forms").Documents("Form1")
    doc.Properties.Delete "EmpName"
    
Set doc = Nothing
Set db = Nothing
End Sub

All the procedures for creating a custom property to save an employee's name, assigning a name to the property, reading it back, displaying it in a message box, and deleting the custom property from Form1 are outlined in the individual subroutines above.

The CWiz_TextBox Wrapper Class.

The CWiz_TextBox Wrapper Class manages the AfterUpdate() Event, allowing for direct entry of color numbers for Red, Green, and Blue into the TextBoxes named RN, GN, and BN. The subsequent changes are seamlessly reflected in the Scrollbars, the color graphs situated to the right of the Scrollbars, the new color showcased in the large rectangle label background, and the RGB color number displayed in the Textbox.

You may save your new Color in the Color Grid as explained earlier.

The CWiz_TextBox Wrapper Class Module Code is given below:

Option Compare Database
Option Explicit

Private WithEvents ctxt As Access.TextBox
Private cFrm As Form

Const GraphFactor = (1 / 255) * 1440
Private db As Database
Private doc As Document

Public Property Get c_Frm() As Form
    Set c_Frm = cFrm
End Property

Public Property Set c_Frm(ByRef vcFrm As Form)
    Set cFrm = vcFrm
End Property

Public Property Get c_txt() As Access.TextBox
    Set c_txt = ctxt
End Property

Public Property Set c_txt(ByRef vctxt As Access.TextBox)
    Set ctxt = vctxt
    
    Set db = CurrentDb
    Set doc = db.Containers("Forms").Documents("ColorPalette")
End Property

Private Sub ctxt_AfterUpdate()
 With cFrm
    Select Case ctxt.Name
        Case "RN"
            .Ctl_R.Value = cFrm![RN]
            doc.Properties("RN").Value = cFrm!RN
            .CheckBox.Value = False
        Case "GN"
            .Ctl_G.Value = cFrm![GN]
            doc.Properties("GN").Value = cFrm!GN
            .CheckBox.Value = False
        Case "BN"
            .Ctl_B.Value = cFrm![BN]
            doc.Properties("BN").Value = cFrm!BN
            .CheckBox.Value = False
    End Select
  End With
End Sub

The CWiz_Label Wrapper Class.

The Labels in the ColorGrid, the color graph Labels beside the ScrollBars, and the RGB color display Label are all managed through their Click event subroutines within the CWiz_Label Wrapper Class.

The CWiz_Label Wrapper Class Module Event Procedure Code is given below:

Option Compare Database
Option Explicit

Private WithEvents clbl As Access.Label
Private sFrm As Form

Const GraphFactor = (1 / 255) * 1440
Private db As Database
Private doc As Document

Private selflag As Boolean
Private lngColor As Long

Public Property Get s_Frm() As Form
    Set s_Frm = sFrm
End Property

Public Property Set s_Frm(ByRef vsFrm As Form)
    Set sFrm = vsFrm
End Property

Public Property Get s_clbl() As Access.Label
    Set s_clbl = clbl
End Property

Public Property Set s_clbl(ByRef vclbl As Access.Label)
    Set clbl = vclbl
    
    Set db = CurrentDb
    Set doc = db.Containers("Forms").Documents("ColorPalette")
End Property

Private Sub clbl_Click()
Dim I As Integer
If Val(Mid(clbl.Name, 5)) > 0 Then
    I = Val(Mid(clbl.Name, 5))
End If
Select Case I
    Case 1 To 25
        Call Boxes(I) 'Click on Color Grid
End Select

Select Case clbl.Name
    Case "Color"
        Call ColorClick 'Click on the RGB Color Display Label
    Case "Clip"
       Call ClipClick   'Click on this Labek to Copy RGB Color number to ClipBoard
End Select
End Sub

Private Sub ColorClick()
With sFrm
    lngColor = .Color.BackColor
    !RGBColor = .Controls("Color").BackColor
    .Controls("Color").SpecialEffect = 2
    
    'Copy the created color to the grid
    !CheckBox.Value = True
End With
End Sub

Private Sub ClipClick()
    If Not IsNull(sFrm![RGBColor]) Then
        ' Copy the TextBox contents to the clipboard
        sFrm.RGBColor.SetFocus
        DoCmd.RunCommand acCmdCopy
        MsgBox "RGB Color Number Copied to Clipboard!", vbInformation
    Else
        ' Display a message if the TextBox is empty
        MsgBox "RGBColor is empty!", vbExclamation
    End If

End Sub

Private Sub Boxes(ByVal bx As Integer)
Dim j As Integer
Dim ctl As String
Dim Colr As Long
Dim intR As Integer
Dim intG As Integer
Dim intB As Integer

selflag = sFrm!CheckBox.Value

For j = 1 To 25
If j = bx Then
   If selflag Then
    With sFrm
      ctl = "lblC" & j
        .Controls(ctl).SpecialEffect = 2
        .Controls(ctl).BackColor = .Color.BackColor
        doc.Properties("Selected").Value = .Controls(ctl).BackColor
        !RGBColor = .Controls(ctl).BackColor
        !CheckBox.Value = False
      ctl = "C" & j
      doc.Properties(ctl).Value = .Color.BackColor
      doc.Properties("Selctl").Value = "C" & j
    End With
   Else
    With sFrm
         ctl = "lblC" & j
            !RGBColor = .Controls(ctl).BackColor
            .Controls(ctl).SpecialEffect = 2
         doc.Properties("Selected").Value = .Controls(ctl).BackColor
         doc.Properties("Selctl").Value = "C" & j
   End With
   
 Colr = sFrm!RGBColor
 'Split into R,G,B
 intR = Colr Mod 256
 intG = Colr \ 256 Mod 256
 intB = Colr \ 256 \ 256 Mod 256
 
 With sFrm
    !RN = intR
    .Ctl_R.Value = sFrm!RN
    !GN = intG
    .Ctl_G.Value = sFrm!GN
    !BN = intB
    .Ctl_B.Value = sFrm!BN
 
    .R.Width = GraphFactor * intR
    .G.Width = GraphFactor * intG
    .B.Width = GraphFactor * intB

    .R.BackColor = RGB(intR, 0, 0)
    .G.BackColor = RGB(0, intG, 0)
    .B.BackColor = RGB(0, 0, intB)

    .Color.BackColor = RGB(intR, intG, intB)
  End With
  With doc
    .Properties("RGBColor").Value = sFrm.Color.BackColor
    .Properties("RN").Value = intR
    .Properties("GN").Value = intG
    .Properties("BN").Value = intB
  End With
  End If
   
Else
   ctl = "lblC" & j
   sFrm.Controls(ctl).SpecialEffect = 0
End If

Next

End Sub

The Intermediary Class Module CWiz_ObjInit VBA Code is given below:

Option Compare Database
Option Explicit

Private cw As CWiz_Label
Private txt As CWiz_TextBox
Private WithEvents cmd As CommandButton

Private WithEvents frm As Form
Private coll As New Collection

Const GraphFactor = (1 / 255) * 1440
Const MaxColor = 25
Private cdb As Database, ctr As Container, doc As Document


Public Property Get o_Frm() As Form
    Set o_Frm = frm
End Property

Public Property Set o_Frm(ByRef voFrm As Form)
    Set frm = voFrm
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"
Dim I As Integer

Call ColorPalette_Init 'Initialize

Set cmd = frm.cmdClose
    cmd.OnClick = EP
     
For Each ctl In frm.Controls

 I = Val(Mid(ctl.Name, 5))
 
  Select Case TypeName(ctl)
    Case "Label"
      Select Case I
          Case 1 To 25
            Set cw = New CWiz_Label
            Set cw.s_Frm = frm
            Set cw.s_clbl = ctl
                cw.s_clbl.OnClick = EP
            coll.Add cw
            Set cw = Nothing
      End Select
      Select Case ctl.Name
        Case "Color"
            Set cw = New CWiz_Label
            Set cw.s_Frm = frm
            Set cw.s_clbl = ctl
                cw.s_clbl.OnClick = EP
                
            coll.Add cw
            Set cw = Nothing
        Case "Clip"
            Set cw = New CWiz_Label
            Set cw.s_Frm = frm
            Set cw.s_clbl = ctl
                cw.s_clbl.OnClick = EP
            coll.Add cw
            Set cw = Nothing
        End Select
     
      Case "TextBox"
        Select Case ctl.Name
            Case "RN", "GN", "BN"
              Set txt = New CWiz_TextBox
              Set txt.c_Frm = frm
              Set txt.c_txt = ctl
                txt.c_txt.AfterUpdate = EP
                coll.Add txt
              Set txt = Nothing
            Case "RGBColor"
              Set txt = New CWiz_TextBox
              Set txt.c_Frm = frm
              Set txt.c_txt = ctl
                txt.c_txt.OnGotFocus = EP
                coll.Add txt
              Set txt = Nothing
        End Select
    End Select
Next
End Sub

Private Sub ColorPalette_Init()
Dim xRN As Integer
Dim xGN As Integer
Dim xBN As Integer
Dim xRGBColor As Long
Dim j As Integer
Dim cdb As Database
Dim ctr As Container
Dim doc As Document
Dim strctl As String

Set cdb = CurrentDb
Set ctr = cdb.Containers("Forms")
Set doc = ctr.Documents("ColorPalette")

xRN = doc.Properties("RN").Value
xGN = doc.Properties("GN").Value
xBN = doc.Properties("BN").Value
xRGBColor = doc.Properties("RGBColor").Value

With frm 
    ![RN] = xRN
    ![GN] = xGN
    ![BN] = xBN
    .R.Width = xRN * GraphFactor
    .R.BackColor = RGB(xRN, 0, 0)
    
    .G.Width = xGN * GraphFactor
    .G.BackColor = RGB(0, xGN, 0)
    
    .B.Width = xBN * GraphFactor
    .B.BackColor = RGB(0, 0, xBN)
    
.Ctl_R.Value = xRN
.Ctl_G.Value = xGN
.Ctl_B.Value = xBN

.Color.BackColor = RGB(xRN, xGN, xBN)
.RGBColor = .Color.BackColor
End With

For j = 1 To MaxColor
   strctl = "lblC" & j
   frm.Controls(strctl).BackColor = doc.Properties("C" & j).Value
   If ("C" & j) = doc.Properties("Selctl").Value Then
      frm.Controls(strctl).SpecialEffect = 2
   End If

Next j

Form_Load_Exit:
Exit Sub

Form_Load_Err:
MsgBox Err.Description, , "Form_Load"
Resume Form_Load_Exit

End Sub

Private Sub cmd_Click()
Dim msg As String
Dim ctl As String, strC1 As String, j As Integer

msg = "Close the Color Wizard?"
If MsgBox(msg, vbYesNo + vbQuestion, "cmd_Click()") = vbYes Then

    Set cdb = CurrentDb
    Set ctr = cdb.Containers("Forms")
    Set doc = ctr.Documents("ColorPalette")

For j = 1 To MaxColor
  ctl = "lblC" & j
  strC1 = "C" & j
    doc.Properties(strC1).Value = frm.Controls(ctl).BackColor
  If frm.Controls(ctl).SpecialEffect = 2 Then
      doc.Properties("Selected").Value = frm.Controls(ctl).BackColor
      doc.Properties("SelCtl").Value = strC1
  End If
Next
    doc.Properties("RGBColor").Value = Nz(frm.Controls("RGBColor").Value, 0)
    DoCmd.Close acForm, frm.Name
End If
End Sub

Private Sub Class_Terminate()
Do While coll.Count > 1
    coll.Remove 1
Loop
End Sub

When the form is opened, the form object is passed to the intermediary class module, initiating the execution of the Class_Init subroutine. The first subroutine, ColorPalette_Init, is invoked from within the Class_Init subroutine. This procedure retrieves all the values saved in the form's custom properties and assigns them to the labels, scroll bars, and text boxes on the form.

This procedure is normally run in the Form_Load() Event Procedure, and the current Values on the Form Controls are saved when the Form is closed.

There is a single command button to close the form. A singular command button object instance is created in the Intermediary Class Module, and its Click Event is enabled. Consequently, when the cmdClose command button is clicked, the form close event procedure is executed in the CWiz_ObjInit Module. Before closing the form, all the values of the Color Wizard form controls are saved in the form's custom properties.

This topic was initially published in October 2010, featuring a color palette of 15 colors, and all the wizard VBA code was implemented in the Form Module. The older version of the wizard form is included in the demo database, labeled ColorPaletteOld. Feel free to open and review the code, assessing how it has been transformed into a form that can now be executed from the standalone class module, excluding the VBA code related to the ActiveX Control ScrollBar.

Demo Database Download Link.

RGB_Colors.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Event Procedures 3DTextWizard

2023-11-11T11:17:00.012+05:30

The 3D Heading Creation Wizard for Form and Report.

The 3D Text Wizard was first introduced in a series of articles published in September 2006. I originally created this website to share practical tips and techniques, many of which I had applied in real-world projects while working in an automotive company in the Sultanate of Oman. At that time, the wizard was demonstrated using the QBColor version, offering a straightforward way to explore color effects.

Now updated, the 3D Text Wizard provides access to a wider RGB spectrum, making color selection more versatile than ever. To further enhance customization, a dedicated ColorList table has been added, enabling users to expand the palette with their own preferred colors.

This feature is highly beneficial when creating three-dimensional text effects for form headings or for displaying field values—such as employee names or product names—making them more visually striking, especially when viewed from a distance.

Example-1: Employee Name.

Example-2:Order Details Form View-2

The 3D Text Wizard Image is given below:

The event procedures and functions in the 3D Text Wizard have been streamlined in line with the new Event Procedure Coding Rules implemented in the standalone class module. This structured approach improves code organization and readability while making maintenance and future development more efficient.

3D Text Creation Technique.

The 3D Text is crafted through layers of Label Controls or Text Boxes, each containing the same text. Alternatively, this effect can be manually achieved by strategically placing layers with an attractive color on top and additional layers with a darker forecolor behind, slightly shifted to one of the four corners—top-left, bottom-left, top-right, or bottom-right. This technique imparts a shadow effect, enhancing the visual appeal of the text.

Performing this task manually each time can be a time-consuming exercise. As you may have observed in earlier episodes, I created headings for my Forms using only two labels, achieving a 3D-like appearance effortlessly.

To the left of the Text Wizard user interface, you'll find a ListBox displaying a variety of colors. This ListBox is linked to a table named 'Colors,' providing the flexibility to add additional color codes as needed.

On the right side of the Colors List, there are two OptionGroup controls. The top one features two options. When the first radio button is selected, the color chosen from the ListBox will be displayed in the top rectangle control. This selected color will then be applied to the topmost label's caption or the font color of the TextBox used for the 3D Text.

If the second radio button is selected, the color chosen from the ListBox is applied to the border color of the first two Wizards, namely Border 2D and Border 3D, within the Options Group Control below. It's worth noting that other Text Style Wizard options exclusively utilize the ForeColor option.

The 3D Text Shadow Positions.

At the top right side, there is a ComboBox with four options (0-3) to specify the positions of the light and shadow for the 3D Text.

Shadow Positions:

0 - Left Top Corner.

1 - Left Bottom Corner.

2 - Right Top Corner

3 - Right Bottom Corner

The first text style, 2D, creates a white border around the text and doesn't require additional settings. For both 2D and 3D text styles, the wizard achieves the effect by creating five or seven labels with the same text and different ForeColor, positioning them underneath the top label, and slightly adjusting their placement towards the shadow position. In the case of the 2D border design, the other labels are moved towards the four corners of the top label.

3D Text Control Types.

The ComboBox positioned below the Shadow Style ComboBox offers two options and utilizes two types of controls to generate the 3D Text.

1 - Label

2 - TextBox

The first option is good for creating Static Headings on Forms or Reports.

The second option is TextBox-based 3D Text. It is good for displaying data from Form or Report Field(s) by creating Expressions, like the Images given at the top of this Page.

After selecting the desired options, click on the 'Create 3D Text' Command Button to generate the 3D Text. The resulting 3D Text is displayed in the Detail Section of a new Form. Beneath the 3D Text, a label control provides instructions on how to modify the text, font, font size, and font styles, such as bold, italics, and underline, if necessary. Users can carefully select the top label or TextBox without shifting it from its original position to change the label caption or TextBox contents.

After making changes, select all the Labels or TextBox Controls together by clicking near the controls and dragging over all the labels. Copy and paste them to the desired location where you want them to appear.

To display the form field(s) data in the TextBox controls, write the expression, such as =[First Name] & " " & [Last Name], in the Control Source Property after selecting all the text boxes together for the 3D Text.

After generating a text style, you have the option to preserve it within the 3D Text Wizard. You can then import it into other projects, making it available for use with modifications.

With this streamlined event procedure coding in the standalone class module, only a single Wrapper class is needed for Command Buttons on the form.

There's only one ListBox control on the form, and its Click-Event can be captured in a subroutine within the intermediary Class Module.

Similarly, there are two Option Group Controls on the form—one with the Style of 3D Text options and the other managing Fore-Color and Back-Color parameter selection activities. The Back-Color option specifically applies to the first two text styles, for 2D and 3D Border Color Options. When either of these two options is selected, the Back-Color option will be in an enabled state; otherwise, it will be disabled.

Since both of these actions can be controlled from the TextStyle Selection Option Group Control, a separate wrapper class module is not required. In both the ListBox and Options Group Control, we declared the object Instances of the ListBox and Options Group Control in the Intermediary Class Module, qualified with the keyword WithEvents. The two ComboBoxes on the Form are used for setting the required 3D Text Shadow Options, and the other ComboBox is for selecting the Label or Text Control option. There are no Event Procedures to run for these two Controls.

The Form Module VBA Code.

Both the ListBox and the Option Group Control's Click Events are enabled in the Class_Init() subroutine, and corresponding subroutines are written in this module. First, the Form Module Code is listed below:

Option Compare Database
Option Explicit

Private W As TWiz_Obj_Init

Private Sub Form_Load()
Set W = New TWiz_Obj_Init
Set W.w_frm = Me

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set W = Nothing
End Sub

The TWiz_Obj_Init class is declared in the global area of the module with the object name 'W.' In the Form_Load() event procedure, the object is instantiated, and the current form object (Me) is passed to the W.w_frm() Property Procedure. When the form is closed, the class object 'W' is released from memory.

The TWiz_Obj_Init Class Module Code is Listed Below.

Option Compare Database
Option Explicit

Private wcmd As TWiz_CmdButton

Private WithEvents lst As Access.ListBox
Private WithEvents opt As Access.OptionGroup

Private wfrm As Access.Form
Private Coll As New Collection

Public Property Get w_frm() As Form
  Set w_frm = wfrm
End Property

Public Property Set w_frm(ByRef vfrm As Form)
Set wfrm = vfrm
DoCmd.Restore
 
Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Const EP = "[Event Procedure]"

Set opt = wfrm.TxtStyle '3D Text Styles
    opt.OnClick = EP

Set lst = wfrm.ColorList 'List of Colors
    lst.OnClick = EP

For Each ctl In wfrm.Controls
    Select Case TypeName(ctl)
        Case "CommandButton"
          Select Case ctl.Name
            Case "cmd3D", "cmdClose"
              Set wcmd = New TWiz_CmdButton
              Set wcmd.c_Frm = wfrm
            Set wcmd.c_cmd = ctl
                wcmd.c_cmd.OnClick = EP
                Coll.Add wcmd
            Set wcmd = Nothing
          End Select
    End Select
Next
End Sub

Private Sub lst_Click()
Dim cl As Long
cl = lst.Value
Select Case lst.Name
    Case "ColorList"
    If wfrm.FBack = 1 Then
        wfrm.Fore.BackColor = cl
        wfrm.CFore = cl
    Else
        wfrm.Back.BackColor = cl
        wfrm.CBack = cl
    End If

End Select
End Sub

Private Sub opt_Click()
Dim opval As Integer

Select Case opt.Name
    Case "TxtStyle"
        opval = opt.Value
        With wfrm.cboStyle
            If opval > 1 Then
                .Enabled = True
            Else
                .Enabled = False
            End If
        End With
        With wfrm.Opt2
            Select Case opval
                Case 1, 2
                    .Enabled = True
                Case Else
                    .Enabled = False
            End Select
        End With
End Select
End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

The following ListBox and OptionGroup Controls declarations are placed in the Global area of the Class Module.

 
Private WithEvents lst As Access.ListBox
Private WithEvents opt As Access.OptionGroup

The following statements in the Class_Init() Subroutine assign the References from these Objects in the Form and enable their Click Events, by assigning the "[Event Procedure]" text in their Event Properties:

Set opt = wfrm.TxtStyle '3D Text Styles
    opt.OnClick = EP

Set lst = wfrm.ColorList 'List of Colors
    lst.OnClick = EP

Both these objects, Sub lst_Click() and Sub opt_Click() Event Subroutines, are written below the Sub Class_Int() Procedure.

The Command Button Wrapper Class Module.

There is only one Wrapper Class for both the CommandButtons on the Form. All the Wizard Functions are called from the Command Button with the Caption Create 3D Text Click Event Procedure, depending on the 3D Text Style Option selected.

The CommandButton Wrapper Class Subroutine that Calls the Wizard Functions is listed below for reference.

Option Compare Database
Option Explicit

Private WithEvents cmd As Access.CommandButton
Private cfrm As Access.Form

Public Property Get c_Frm() As Form
   Set c_Frm = cfrm
End Property

Public Property Set c_Frm(ByRef vfrm As Form)
   Set cfrm = vfrm
End Property

Public Property Get c_cmd() As CommandButton
   Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef vcmd As CommandButton)
   Set cmd = vcmd
End Property

Private Sub cmd_Click()
Select Case cmd.Name
    Case "cmd3D"
        Call Create3D(cfrm) 'Call the 3D Text Wizard
        
    Case "cmdClose"
If MsgBox("Close the 3DTextWizard? ", vbYesNo + vbQuestion, "cmdClose_Click()") = vbYes Then
    DoCmd.Close acForm, cfrm.Name
End If
End Select

End Sub

The Cmd3D Click Event Subroutine invokes the Create3D(cfrm) Subroutine and passes the Form Object as a Parameter. This Subroutine in the Standard Module gathers the 3D Text Wizard option settings from the Form into related variables and then calls the wizard function based on the selected text style. Each Wizard function, such as Border2D(), calls three different programs to create the 3D Text.

For example, the Border2D Wizard calls the following three Functions to complete the full task of creating the 3D Text:

FormTxtLabels() ' Creates a Form and the Label or Text Controls
Validate_Dup() ' Performs a Validation check.
MsgLabel() 'Creates a Label control with instructions to use the 3D Text.

Listing all the Wizard VBA codes here is not feasible due to their large volume. However, the 3DTextWizard Demo Database is attached with all the code. You can download it from the link provided at the end of this Page. All the Wizard VBA codes are available in the TxtWizard Standard Module.

Visit the following Links to Articles published earlier for more details on the Wizard Functions:

Demo Database Download Link.

3DTextWizard.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form VBA External Files List HyperLinks

2023-10-30T17:47:00.020+05:30

External Files List in Hyperlinks Form.

The 'Office.FileDialog' Control

The FileDialog Control displays files from the selected folder as hyperlinks within the form. Clicking on a hyperlink opens the file in its native application, if installed.

The control supports user-defined filters, enabling users to narrow down the file list by category—for example, Word documents, Excel worksheets, Access databases, or all files in the folder. Once the required files are selected, clicking the Create File Link command button adds them to a table and displays them in the form’s datasheet view as hyperlinks. For reference, the full file path is also shown in a separate column.

Files' List Display Image.

Right-click to open Large Image in New Tab/Window.

After entering the file filter in the Pathname text box, click the Create File Links command button. This action opens the File Browser control, which displays the available files and folders based on the filter settings.

Right-click to open Large Image in New Tab/Window.

At this stage, you may navigate to and select any folder to search for files. To choose multiple adjoining files, click on the first file, hold down the Shift key, and then click on the last file. Finally, click the Open command button. The selected files will then appear in the list, as shown in the first image.

The Form Module VBA Code.

Option Compare Database
Option Explicit

Private FD As New FLst_Object_Init

Private Sub Form_Load()
    Set FD.fl_Frm = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set FD = Nothing
End Sub

In the global declaration area, an instance of the FLst_Object_Init class module is declared with the name FD. The keyword New is used to create the object instance in memory.

In the Form_Load() event procedure, the current form object is passed to the FD.fl_Frm property of the FD instance.

The FLst_Object_Init Class Module Code.

The FLst_Object_Init with the Class_Init() Subroutine VBA Code is given below:

Option Compare Database
Option Explicit

Private cmd As FLst_CmdButton
Private frm As Access.Form
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Disk Directory Listing in Hyperlinks
'Author: a.p.r. pillai
'Date  : 25/10/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get fl_Frm() As Access.Form
    Set fl_Frm = frm.m_cFrm
End Property

Public Property Set fl_Frm(ByRef pNewValue As Access.Form)
    Set frm = pNewValue
    
    Call Class_Init
End Property

Private Sub Class_Init()
Dim ctl As Control
Dim listcount As Long
Const EP = "[Event Procedure]"

'=============================
'Calling the Public Function ButtonStatus() From FLst_CmdButton Class
'from the Flst_CmdButton Class directly,
Set cmd = New FLst_CmdButton 'Create a separate instance
Set cmd.cmd_Frm = frm 'Pass the Form Object to the Property

Call cmd.ButtonStatus 'Call the Public Function, with Param, if any
Set cmd = Nothing 'Remove the instance
'=============================

For Each ctl In frm.Controls
Select Case TypeName(ctl)
      Case "CommandButton"
        Select Case ctl.Name
            Case "cmdHelp", "cmdFileDialog", _
            "cmdDelLink", "cmdDelFile", _
            "cmdClose", "cmdDelAll"
            
                Set cmd = New FLst_CmdButton
                Set cmd.cmd_Frm = frm
                Set cmd.c_cmd = ctl
        
                    cmd.c_cmd.OnClick = EP
                Coll.Add cmd
                Set cmd = Nothing
        End Select
End Select
Next

End Sub

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

The following two Subroutines, if present in the Class Module, run automatically.

Class_Initialize()
Class_Terminate()

Assume that we have both the above Subroutines in ClassA.

When you create an instance of ClassA inside ClassB, for example:


Dim A As ClassA  
Set A = New ClassA

The Class_Initialize() subroutine of ClassA runs automatically (if it exists). You can place any initialization code here to prepare the class for use.

When the statement Set A = Nothing is executed, or when the ClassB object itself is unloaded, the Class_Terminate() subroutine in ClassA executes. This is where you can perform clean-up tasks, such asSet Obj = Nothing releasing memory and resources.

This mechanism is especially useful when your class contains other objects—like a Collection, Dictionary, or additional class instances—that must be explicitly cleared.

The following Class1 module is instantiated within the form module.

'Class1
Dim DT As ClsDateTime

Private Sub Class_Initialize()
  Set DT = New ClsDateTime
  Forms("Form2").Text2 = DT.DateTime
End Sub

Private Sub Class_Terminate()
 Set DT = Nothing

End Sub

The Class_Initialize() subroutine, if defined in a class module, executes automatically when the class object is instantiated. However, in our streamlined VBA coding approach, we are unable to leverage this feature. The reason is that the class requires the Form object reference to be available before the initialization routine can run. Since the Form object is not yet available at the moment of instantiation, we cannot rely on Class_Initialize().

Instead, we explicitly call the Class_Init() subroutine immediately after acquiring the Form object reference within the class module’s Property Set procedure. This ensures that initialization takes place only after the required Form reference is available.

That doesn’t mean the Class_Initialize() subroutine is unusable in this context. We can still take advantage of it to instantiate supporting objects, such as a Collection or Dictionary, or any other objects that do not depend on the Form reference. For instance, you might use it to create and prepare a Collection object as shown below:

Private Sub Class_Initialize()
	Set Coll = New Collection
End Sub

The Collection object is declared in the global declaration area of the Class Module. Since we used the New keyword in the declaration statement, explicit initialization code inside the Class_Initialize() subroutine is not required—the object is automatically created when the class instance is instantiated.

The Class_Terminate() subroutine, on the other hand, is very useful for memory management. It acts much like the Form_Unload() event procedure, providing a place to release object references and perform any necessary cleanup before the class instance is destroyed.

Private Sub Class_Terminate()
Do While Coll.Count > 0
    Coll.Remove 1
Loop
End Sub

The above code ensures that the Collection object is cleared when the FLst_Object_Init Class Module unloads from memory.

For this project, only two Wrapper Class Modules are required:

FLst_Object_Init — which contains the Class_Init() subroutine.
FLst_CmdButton — which handles all Command Button operations on the form.

The FLst_CmdButton class contains several subroutines. For clarity and better organization, each Command Button’s Click Event procedure calls its corresponding subroutine from this class, instead of placing the entire block of code directly under the Command Button event. This approach makes the code more modular, easier to read, and simpler to maintain.

The FLst_CmdButton Class Module Code.

'The Click Event Subroutines
Private Sub cmd_Click()
Select Case cmd.Name
  Case "cmdClose"
    If MsgBox("Close this Form?", vbOKCancel + vbQuestion, "cmd_Click") = vbOK Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If

    Case "cmdFileDialog"
        Call cmdFileDialog 'Display selected Path & files
        
    Case "cmdDelLink"
        Call cmdDelLink 'Delete Selected Link from list
    
    Case "cmdDelAll"
        Call cmdDelAll 'Delete All Links from list
    
    Case "cmdDelFile"
        Call cmdDelFile 'Delete Link and File from Disk
        
    Case "cmdHelp"
        DoCmd.OpenForm "Help", acNormal 'Show help Form
End Select
End Sub

The cmdFileDialog() Subroutine.

This Subroutine is run by clicking on the Command Button with the Caption Create File Links.

Private Sub cmdFileDialog()
On Error GoTo cmdFileDialog_Click_Err

'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As office.FileDialog
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim defPath As String
Dim varFile As Variant
Dim strfiles As String

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections of disk files.
      .AllowMultiSelect = True
      .InitialFileName = Dir(strPath)
      .InitialView = msoFileDialogViewDetails
      'Set the title of the dialog box.
      .Title = "Please select one or more files"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.mdb; *.accdb"
      .Filters.Add "Excel WorkBooks", "*.xlsx; *.xlsm; *.xls; *.csv"
      .Filters.Add "Word Documents", "*.docx; *.doc"
      .Filters.Add "Access Projects", "*.adp"
      .Filters.Add "All Files", "*.*"
      .FilterIndex = 1
      '.Execute
      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
    If .Show = True Then
        Set db = CurrentDb
        Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
        'Add all selected files to the DirectoryList Table
        defPath = ""
      For Each varFile In .SelectedItems
         If defPath = "" Then
            defPath = Left(varFile, InStrRev(varFile, "\"))
            defPath = defPath & "*.*"
            cmdfrm.PathName = defPath
            cmdfrm.PathName.Requery
            strPath = defPath
         End If
            rst.AddNew
            'Create Hyperlink in 4 segments
            '1st segment: only the File Name
            strfiles = Mid(varFile, InStrRev(varFile, "\") + 1)
            '2nd segment:Full File PathName,3rd Empty,4th TipText
            strfiles = strfiles & "#" & varFile & "##Click"
            rst![FileLinks] = strfiles
            rst![Path] = varFile
            rst.Update
    Next
        
    Call ButtonStatus

        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
      
   End With

cmdFileDialog_Click_Exit:
Exit Sub

cmdFileDialog_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdFileDialog_Click()"
Resume cmdFileDialog_Click_Exit
End Sub

The statement


Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

opens the File Browser Dialog Control and initializes its various properties. Within this control, file type filters can be defined, allowing users to select specific categories of files when browsing from the default path setting.

If users are unsure about the file selection process, they can click on the Help Command Button located at the top right of the form. This button provides detailed guidance on the purpose of each command button and explains the different ways files can be selected.

A table named DirectoryList is designed to store the selected files. The first column saves the files in hyperlink format, while the second column records the full file path for reference. Clicking on a hyperlink will open the file in its native application (e.g., MS Word, Excel, etc.).

The statement


Call ButtonStatus()

invokes the ButtonStatus() subroutine, which checks whether the DirectoryList table contains any records. If the table is empty, all command buttons (except Create File Links and Help) are disabled. This subroutine is also called from other procedures as well as from the FLst_Object_Init class module (refer to the red-highlighted code inside the Class_Init() subroutine above).

Another important point: if you create a Public function inside a stand-alone class module, it becomes accessible across other class modules or standard modules within the application. This means such a function can be called and reused from outside its defining class.

In the next step, we will conduct some trial runs to explore how to call a function from:

another Class Module,
a Standard Module, and
a Form Module.

The cmdDelLink Subroutine.

To delete a record from the hyperlink list, first click on the Record Selector button to highlight the desired record. Then click the Delete Link command button. Before the record is permanently removed, a confirmation message will appear, giving you the option to proceed with the deletion or cancel the action.

'Delete the Link From the List
Private Sub cmdDelLink()
On Error GoTo cmdDelLink_Click_Err
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strFile As String
Dim msg As String

'Read the current record Pathname
strFile = cmdfrm.DirectoryList.Form!Path
Set db = CurrentDb
Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
rst.FindFirst "Path = '" & strFile & "'"
If Not rst.NoMatch Then
    msg = UCase("Link: " & strFile & vbCr & "DELETE from above List?")
    
If MsgBox(msg, vbQuestion + vbYesNo, "cmddelLink_Click()") = vbYes Then
    rst.Delete
    rst.Requery
    cmdfrm.DirectoryList.Form.Requery
    MsgBox UCase("File Link: " & strFile & " Deleted.")
End If
Else
    MsgBox UCase("Link: " & strFile & " Not Found!!")
End If

Call ButtonStatus

rst.Close
Set rst = Nothing
Set db = Nothing

cmdDelLink_Click_Exit:
Exit Sub

cmdDelLink_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelLink_Click()"
Resume cmdDelLink_Click_Exit
End Sub

The cmdDelAll() Subroutine.

This subroutine deletes all records from the DirectoryList table. Once the deletion is complete, all three command buttons associated with delete actions are disabled. They remain disabled until at least one file is added back to the hyperlink list.

Private Sub cmdDelAll()
Dim msg As String
Dim yn As Integer
Dim listcount As Long

On Error GoTo cmdDelAll_Click_Err
listcount = DCount("*", "DirectoryList")
If listcount = 0 Then
    cmdfrm.cmdDelAll.Enabled = False
    Exit Sub
Else
    cmdfrm.cmdDelAll.Enabled = True
End If

msg = "All File Links in the List will be Deleted!"
msg = msg & vbCr & "Are You sure?"
If MsgBox(msg, vbYesNo + vbCritical, "cmdDelAll()") = vbYes Then
    If MsgBox("Deleting All File Links?", vbOKCancel + vbInformation, "cmdDelAll()") = vbOK Then
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "DeleteAll_LinksQ", acViewNormal
        DoCmd.SetWarnings True
        cmdfrm.DirectoryList.Form.Requery
        cmdfrm.cmdDelAll.Enabled = False
    End If
End If

Call ButtonStatus

cmdDelAll_Click_Exit:
Exit Sub

cmdDelAll_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelAll_Click()"
Resume cmdDelAll_Click_Exit
End Sub

The cmdDelFile() Subroutine.

Caution:

Be cautious when using this command button. Clicking it will permanently delete the file from the disk as well as remove its hyperlink from the list. Use this option only when you intend to delete the actual file from your system, not just the link.

'Caution: Deletes the File from Disk
'1. Delete the File from Disk
'2. Remove selected link from List
Private Sub cmdDelFile()
On Error GoTo cmdDelFile_Click_Err
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strFile As String
Dim msg As String

'Read selected Record Pathinfo
strFile = cmdfrm.DirectoryList.Form!Path
Set db = CurrentDb
Set rst = db.OpenRecordset("DirectoryList", dbOpenDynaset)
rst.FindFirst "Path = '" & strFile & "'"
If Not rst.NoMatch Then
    msg = UCase("File: " & strFile & vbCr & "DELETE from Disk?")
If MsgBox(msg, vbQuestion + vbYesNo, "cmdDelFile_Click") = vbYes Then
    
   If MsgBox(UCase("Are you sure you want to Delete") & vbCr _
   & UCase(rst!Path & " File from DISK?"), vbCritical + vbYesNo, "cmdDelFile_Click()") = vbNo Then
    GoTo cmdDelFile_Click_Exit
   End If
   'Delete record entry from Table DirectoryList
    rst.Delete
    rst.Requery
    
Call ButtonStatus

    'Delete file from Disk
    If Len(Dir(strFile)) > 0 Then
        Kill strFile
        MsgBox "File: " & strFile & " Deleted."
    Else
        MsgBox "File: " & strFile & vbCr & "Not Found on Disk!"
    End If
  End If
Else
    MsgBox "File: " & strFile & " Not Found!!"
End If

cmdDelFile_Click_Exit:
    rst.Close
    Set rst = Nothing
    Set db = Nothing
Exit Sub

cmdDelFile_Click_Err:
MsgBox Err & " : " & Err.Description, , "cmdDelFile_Click()"
Resume cmdDelFile_Click_Exit
End Sub

The ButtonStatus()

All three delete subroutines in the FLst_CmdButton class, as well as those in the FLst_Object_Init class, invoke the public subroutine ButtonStatus(). This subroutine ensures that the command buttons remain disabled whenever the DirectoryList table is empty.

Public Sub ButtonStatus()
Dim listcount As Long

On Error GoTo ButtonsStatus_Err:

listcount = DCount("*", "DirectoryList")
cmdfrm.DirectoryList.Form.Requery

If listcount = 0 Then
    cmdfrm.cmdDelLink.Enabled = False
    cmdfrm.cmdDelAll.Enabled = False
    cmdfrm.cmdDelFile.Enabled = False
Else
    cmdfrm.cmdDelLink.Enabled = True
    cmdfrm.cmdDelAll.Enabled = True
    cmdfrm.cmdDelFile.Enabled = True
End If

ButtonsStatus_Exit:
Exit Sub

ButtonsStatus_Err:
MsgBox Err & " : " & Err.Description, , "ButtonsStatus()"
Resume ButtonsStatus_Exit
End Sub

Calling a Public Function from a Class Module.

Create a Class Module with the name ClsDateTime.

Copy and Paste the following Function Code into the Class Module:

Option Compare Database
Option Explicit

Public Function DateTime() As String
Dim fmt As String

fmt = "dd/mm/yyyy hh:nn:ss"
DateTime = "DateTime: " & Format(Now(), fmt)

End Function

Save the Class Module.
Create a New Form with the name Form1, or any other name you prefer, and open it in Design View.
Add a TextBox Control on the Form and make sure the TextBox Name is Text0.
Display the Form Property Sheet and select the Other Tab in the Property Sheet.
Set the Has Module Property value to Yes to add a Class Module to the Form.
Display the Form1 Code Module, Copy and Paste the following Code in the Form Module, Save and Close the Form:
```
Private Sub Form_Load()
Dim DT As New ClsDateTime

Me.Text0 = DT.DateTime

End Sub
```
Open Form1 in Normal View. The current Date and Time will appear in the TextBox.

In the Form_Load() event procedure, create an instance of the ClsDateTime class module with the object name DT. When you type DT. the DateTime() function will automatically appear in the IntelliSense list. Simply select and call the function, and when the form opens, the current date and time will be displayed in the designated TextBox.

This same procedure can also be applied between two class modules—allowing you to call a function in one class module from another, instead of from the form module.

In our streamlined, structured VBA coding approach, we typically work with three levels of class modules:
1. The Form Module
2. An Intermediary Class Module
3. The Class Module containing the required function (in this case, DateTime())
Let us now test this function in such a three-tier setup, where the form module communicates with the intermediary class, which in turn calls the function in the dedicated class module.
Make a Copy of Form1 and name it Form2.
Rename the TextBox Name to Text2.
1. Display its Class Module, then copy and paste the following two Lines of Code, overwriting the existing lines.
```
Option Compare Database

Private test As New Class1
```
2. Create a Class Module with the Name Class1.
3. Copy and paste the Following Code into the Class1 Module:
```
Option Compare Database

Private D  As New ClsDateTime

Private Sub Class_initialize()
  Forms("Form2").Text2 = D.DateTime
End Sub
```
4. Select Save from the File Menu to save all the Files.
5. Open Form2 in Normal View. The DateTime value should appear in the Text2 TextBox on the Form.
Since class modules cannot load themselves into memory, we used the Form2 module to create an instance of the Class1 module. Once the Class1 class module is instantiated, it in turn creates an instance of the ClsDateTime class module.
At this point, the Class_Initialize() subroutine in ClsDateTime runs automatically. From within this subroutine, the DateTime() public function is called. The result returned by the function is then passed back and displayed in the TextBox on Form2.

✅ This keeps the workflow very clear:
Form2 → Class1 → ClsDateTime (Initialize → DateTime() → Return value → Form2.TextBox)
Hope you understand now how it works.
Try Calling the DateTime() Function from the Standard Module from a Test() Function.

Demo Database Download Link.

DirListing2K1.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form VBA Custom Report Wizard - 16

2023-10-18T08:16:00.011+05:30

Streamlining Custom-Made Reports Wizard Form Module VBA Code.

I hope you enjoyed exploring last week’s Custom Form Wizard, which organized its VBA code into a few standalone Class Modules. This approach allows you to access, review, and study the code directly without interfering with the Form Design or its embedded Form Module.

The Custom Report Wizard shares the same user interface design as the Form Wizard. It was originally published in December 2008 under Access 2003. In this updated version, however, the Report Wizard’s Form Module VBA code has been refactored to run from standalone Class Modules, making it easier to maintain and extend while generating reports.

The Report Wizard is designed with a TabControl containing two pages. On the first TabPage, a ListBox presents two key options, while a ComboBox allows you to select a Table or Query as the data source.

Report in Column Format
Report in Tabular Format

These two options are provided as a Value List in the RowSource property of the ListBox. To ensure that the first option is selected automatically, the Default Value property is set with the expression:


= WizList.Column(0,0)

This initializes the ListBox with the first item pre-selected when the Wizard opens.

The ComboBox Control displays a list of tables and select queries, filtered from the MSysObjects system table. Its Default Value property is set to the expression: =FilesList.Column(0,0), which automatically selects the first item in the list as the default.

The SQL of the File Selection Query.

SELECT MSysObjects.Name
FROM MSysObjects
WHERE (((MSysObjects.Type)=1 Or (MSysObjects.Type)=5) AND ((Left([Name],4))<>'WizQ') AND ((Left([Name],1))<>'~') AND ((MSysObjects.Flags)=0))
ORDER BY MSysObjects.Type, MSysObjects.Name;

The TabControl first page image is given below:

Right-click to open Large Image in New Tab/Window.

Report Wizard Page2 Image:

Right-click to open Large Image in New Tab/Window.

The following lines of the VBA Code are only needed in the Form's Class Module. All other Events, Subroutines, and Functions are placed in the Standalone Class Modules.

Option Compare Database
Option Explicit

Private obj As New RWizObject_Init

Private Sub Form_Load()
    Set obj.fm_fom = Me
End Sub

The RWizObject_Init intermediary Class Module is instantiated with the object name obj in the global declaration section of the Form Module. During the Form_Load() event procedure, the form object reference is passed to the RWizObject_Init class module’s property procedure using the statement:


Set obj.fm_fom = Me

The RWizObject_Init Class.

The RWizObject_Init VBA Code is listed below. All the Report creation functions are placed within this Class Module.

Option Compare Database
Option Explicit

Private fom As Access.Form

Private cmdb As RWiz_CmdButton
Private lstb As RWiz_ListBox
Private comb As RWiz_Combo

Private tb As RWiz_TabCtl
Private Coll As New Collection

'Wizard Functions Running Command Button Instance'
'Functions are placed in this Module
Private WithEvents cmdFinish As Access.CommandButton
Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String

Public Property Get fm_fom() As Form
  Set fm_fom = fom
End Property

Public Property Set fm_fom(ByRef mfom As Form)
  Set fom = mfom
    
  Call Class_Init
End Property

Private Sub Class_Init()
Dim Ctl As Control
Const EP = "[Event Procedure]"

'Filter Table/Select Query Names for ComboBox
Call Create_FilesList

For Each Ctl In fom.Controls
    Select Case Ctl.ControlType
        Case acTabCtl
            Set tb = New RWiz_TabCtl
            Set tb.Tb_Frm = fom
            Set tb.Tb_Tab = Ctl
              tb.Tb_Tab.OnChange = EP
              
              Coll.Add tb
            Set tb = Nothing
        
        Case acCommandButton
            Select Case Ctl.Name
                Case "cmdReport"
                    'Not to add in the Collection object
                    'The Click Event Runs the Wizard Functions
                    'from this Class Module, not from the
                    'Wrapper Class - FWiz_CmdButton
                    
                    Set cmdFinish = fom.cmdReport
                    cmdFinish.OnClick = EP
                Case Else
            
            Set cmdb = New RWiz_CmdButton
            Set cmdb.w_Frm = fom
            Set cmdb.w_cmd = Ctl
                cmdb.w_cmd.OnClick = EP
                
              Coll.Add cmdb
            Set cmdb = Nothing
         End Select
            
        Case acComboBox
            Set comb = New RWiz_Combo
            Set comb.cbo_Frm = fom
            Set comb.c_cbo = Ctl
                comb.c_cbo.OnGotFocus = EP
                comb.c_cbo.OnLostFocus = EP
            
        Case acListBox
            Set lstb = New RWiz_ListBox
            Set lstb.lst_Frm = fom
            Set lstb.m_lst = Ctl
                lstb.m_lst.OnGotFocus = EP
                lstb.m_lst.OnLostFocus = EP
                
                Coll.Add lstb
            Set lstb = Nothing
    End Select
Next
            
End Sub

Private Sub cmdFinish_Click()
        xtyp = fom!WizList
        strFile = fom!FilesList
        If xtyp = 1 Then
            Columns strFile
        Else
            Tabular strFile
        End If
          DoCmd.Close acForm, fom.Name
End Sub

Create_FilesList() Subroutine Code.

The Subroutine that creates the Files List for the ComboBox on the first page of the Wizard.

'Create Tables/Queries List for
Private Sub Create_FilesList()
Dim strSQL1 As String
Dim cdb As DAO.Database
Dim Qry As DAO.QueryDef
Dim FList As ComboBox

On Error GoTo Create_FilesList_Err
DoCmd.Restore

strSQL1 = "SELECT MSysObjects.Name " _
& "FROM MSysObjects " _
& "WHERE (((MSysObjects.Type)=1 Or (MSysObjects.Type)=5) " _
& "AND ((Left([Name],4))<>'WizQ') AND ((Left([Name],1))<>'~') " _
& "AND ((MSysObjects.Flags)=0)) " _
& "ORDER BY MSysObjects.Type, MSysObjects.Name;"

DarkBlue = 8388608
twips = 1440

Set cdb = CurrentDb
Set Qry = cdb.QueryDefs("WizQuery")
If Err = 3265 Then
  Set Qry = cdb.CreateQueryDef("WizQuery")
  Qry.SQL = strSQL1
  cdb.QueryDefs.Append Qry
  cdb.QueryDefs.Refresh
  Err.Clear
End If

With Forms("ReportWizard")
Set FList = .FilesList
    .FilesList.RowSource = "WizQuery"
    .FilesList.Requery
End With

Create_FilesList_Exit:
Exit Sub

Create_FilesList_Err:
MsgBox Err & ": " & Err.Description, , "Create_FilesList()"
Resume Create_FilesList_Exit
End Sub

The Function that Creates the Report in Column Format.

Public Function Columns(ByVal DataSource As String)

Dim cdb As Database
Dim FldList() As String
Dim Ctrl As Control
Dim Rpt As Report
Dim PgSection As Section
Dim DetSection As Section
Dim HdSection As Section

Dim lngTxtLeft As Long
Dim lngTxtTop As Long
Dim lngTxtHeight As Long
Dim lngtxtwidth As Long

Dim lngLblLeft As Long
Dim lngLblTop As Long
Dim lngLblHeight As Long
Dim lngLblWidth As Long

Dim FldCheck As Boolean
Dim strTblQry As String
Dim intflds As Integer
Dim lstcount As Long
Dim RptFields As ListBox
Dim j As Integer


'Create Report with Selected Fields

On Error Resume Next

strFile = DataSource
Set RptFields = fom.SelList
lstcount = RptFields.listcount

If lstcount = 0 Then
   MsgBox "Fields Not Selected for Report!"
   Exit Function
Else
   lstcount = lstcount - 1
End If

ReDim FldList(0 To lstcount) As String

Set cdb = CurrentDb
Set Rpt = CreateReport

Set HdSection = Rpt.Section(acPageHeader)
    HdSection.Height = 0.6667 * twips

Set DetSection = Rpt.Section(acDetail)
    DetSection.Height = 0.166 * twips

For j = 0 To lstcount
  FldList(j) = RptFields.ItemData(j)
Next

With Rpt
    .Caption = strFile
    .RecordSource = strFile
    lngtxtwidth = 1.5 * twips
    lngTxtLeft = 1.1 * twips
    lngTxtTop = 0.0417 * twips
    lngTxtHeight = 0.2181 * twips

    lngLblWidth = lngtxtwidth
    lngLblLeft = 0.073 * twips
    lngLblTop = 0.0417 * twips
    lngLblHeight = 0.2181 * twips
End With

For j = 0 To lstcount

   Set Ctrl = CreateReportControl(Rpt.Name, acTextBox, acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
    With Ctrl
       .ControlSource = FldList(j)
       .FontName = "Comic Sans MS"
       .FontSize = 8
       .FontWeight = 700
       .ForeColor = DarkBlue
       .BorderColor = DarkBlue
       .Name = FldList(j)
       .BackColor = RGB(255, 255, 255)
       .BorderStyle = 1
       .SpecialEffect = 0
     Select Case (j / 9)
     	Case 1,2,3
        	lngTxtTop = (0.0417 * twips)
        	lngTxtLeft = lngTxtLeft + (2.7084 * twips)
        Case Else
        	lngTxtTop = lngTxtTop + .Height + (0.1 * twips)
     End Select
    End With

   Set Ctrl = CreateReportControl(Rpt.Name, acLabel, acDetail, FldList(j), FldList(j), lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
    With Ctrl
       .Caption = FldList(j)
       .Height = (0.2181 * twips)
       .Name = FldList(j) & " Label"
       .Width = twips
       .ForeColor = 0
       .BorderStyle = 0
       .FontWeight = 400
       Select Case (j/9)
       		Case 1,2,3
              lngLblTop = (0.0417 * twips)
        	  lngLblLeft = lngLblLeft + (2.7083 * twips)
       		Case Else
        	  lngLblTop = lngLblTop + .Height + (0.1 * twips)
       End Select
    End With
Next

lngLblWidth = 4.5 * twips
lngLblLeft = 0.073 * twips
lngLblTop = 0.0521 * twips
lngLblHeight = 0.323 & twips
lngLblWidth = 4.5 & twips
 Set Ctrl = CreateReportControl(Rpt.Name, acLabel, acPageHeader, , "Head1", lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
   With Ctrl
        .Caption = strFile
        .TextAlign = 2
        .Width = 4.5 * twips
        .Height = 0.38 * twips
        .ForeColor = DarkBlue
        .BorderStyle = 0
        .BorderColor = DarkBlue
        .FontName = "Times New Roman"
        .FontSize = 20
        .FontWeight = 700 ' Bold
        .FontItalic = True
        .FontUnderline = True
   End With

Page_Footer Rpt

DoCmd.OpenReport Rpt.Name, acViewPreview

Columns_Exit:
Exit Function

Columns_Err:
MsgBox Err.Description, , "Columns"
Resume Columns_Exit
End Function

The Tabular Type Report Creation Function.

In both Wizards, the majority of the VBA code consists of variable declarations used to define the TextBox controls and their associated child Label controls, along with their dimension values. Additional properties—such as Font name, Font size, ForeColor, and other formatting attributes—are applied after the controls are created.

The statement Set Ctrl = CreateReportControl() requires several parameters to be defined before it can be executed. For example:


Set Ctrl = CreateReportControl(Rpt.Name, acTextBox, _
    acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngTxtWidth, lngTxtHeight)

Each parameter has a specific role:

Rpt.Name – The name of the Report where the control will be created.
acTextBox – The type of control to create (in this case, a TextBox).
acDetail – The section of the Report where the control will be placed (here, the Detail section).
Parent – Used if the control belongs to a SubReport (omitted in this example).
FldList(j) – The name of the field to bind to the TextBox.
lngTxtLeft – The Left position of the control.
lngTxtTop – The Top position of the control.
lngTxtWidth – The Width of the control.
lngTxtHeight – The Height of the control.

All these values must be predefined before calling the CreateReportControl() function to ensure the control is created with the correct properties.

After the TextBox control is created, its Font and Color attributes (such as FontName, FontSize, and ForeColor) are applied programmatically.

Next, the TextBox’s child Label control is created in the Page Header section of the Report.

In a Column-Format Report, however, the Label control is placed in the Detail section, positioned to the left side of each TextBox.
While creating the TextBox in this layout, enough horizontal space is reserved on the left to accommodate the Label control.

This ensures that field names (labels) and their corresponding values (textboxes) are neatly aligned and visually clear in the generated Report.

Public Function Tabular(ByVal DataSource As String)

Dim cdb As Database
Dim FldList() As String
Dim Ctrl As Control
Dim Rpt As Report
Dim PgSection As Section
Dim DetSection As Section

Dim lngTxtLeft As Long
Dim lngTxtTop As Long
Dim lngTxtHeight As Long
Dim lngtxtwidth As Long

Dim lngLblLeft As Long
Dim lngLblTop As Long
Dim lngLblHeight As Long
Dim lngLblWidth As Long

Dim FldCheck As Boolean
Dim strTblQry As String
Dim intflds As Integer
Dim lstcount As Long
Dim RptFields As ListBox
Dim j As Integer

'Create Report with Selected Fields

On Error Resume Next
strFile = DataSource

Set RptFields = fom.SelList
lstcount = RptFields.listcount

If lstcount = 0 Then
   MsgBox "Fields Not Selected for Report!"
   Exit Function
Else
   lstcount = lstcount - 1
End If

ReDim FldList(0 To lstcount) As String

Set cdb = CurrentDb

'Create Report Object
Set Rpt = CreateReport
Set PgSection = Rpt.Section(acPageHeader)
    PgSection.Height = 0.6667 * twips

Set DetSection = Rpt.Section(acDetail)
    DetSection.Height = 0.1667 * twips

For j = 0 To lstcount
  FldList(j) = RptFields.ItemData(j)
Next

With Rpt
    .Caption = strFile
    .RecordSource = strFile
    
    lngtxtwidth = 0.5 * twips
    lngTxtLeft = 0.073 * twips
    lngTxtTop = 0
    lngTxtHeight = 0.1668 * twips

    lngLblWidth = lngtxtwidth
    lngLblLeft = lngTxtLeft
    lngLblTop = 0.5 * twips
    lngLblHeight = lngTxtHeight
End With

For j = 0 To lstcount
   Set Ctrl = CreateReportControl(Rpt.Name, acTextBox, _
   acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
    With Ctrl
       .ControlSource = FldList(j)
       .ForeColor = DarkBlue
       .BorderColor = DarkBlue
       .BorderStyle = 1
       .Name = FldList(j)
       lngTxtLeft = lngTxtLeft + (0.5 * twips)
    End With
   
   Set Ctrl = CreateReportControl(Rpt.Name, acLabel, _
   acPageHeader, , FldList(j), lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
   
    With Ctrl
       .Caption = FldList(j)
       .Name = FldList(j) & " Label"
       .Width = (0.5 * twips)
       .ForeColor = DarkBlue
       .BorderColor = DarkBlue
       .BorderColor = 0
       .BorderStyle = 1
       .FontWeight = 700 ' Bold
       lngLblLeft = lngLblLeft + (0.5 * twips)
    End With
Next

lngLblWidth = 4.5 * twips
lngLblLeft = 0.073 * twips
lngLblTop = 0.0521 * twips
lngLblHeight = 0.323 & twips
lngLblWidth = 4.5 & twips
 Set Ctrl = CreateReportControl(Rpt.Name, acLabel, acPageHeader, , "Head1", lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
   With Ctrl
        .Caption = strFile
        .TextAlign = 2
        .Width = 4.5 * twips
        .Height = 0.38 * twips
        .ForeColor = DarkBlue
        .BorderStyle = 0
        .BorderColor = DarkBlue
        .FontName = "Times New Roman"
        .FontSize = 16
        .FontWeight = 700 ' Bold
        .FontItalic = True
        .FontUnderline = True
   End With
On Error GoTo Tabular_Err

Page_Footer Rpt

DoCmd.OpenReport Rpt.Name, acViewPreview

Tabular_Exit:
Exit Function

Tabular_Err:
MsgBox Err.Description, , "Tabular"
Resume Tabular_Exit
End Function

The Page_Footer() Function Code.

This Function is called by both the Column and Tabular Wizards to create the Date and Page Numbers in the PageFooter Section of the Report.

Public Function Page_Footer(ByRef obj)
Dim lngWidth As Long, ctrwidth As Long, ctrlCount As Long
Dim j As Long, cdb As Database
Dim lngleft As Long, lngtop As Long, LineCtrl As Control, Ctrl As Control
Dim rptSection As Section, leftmost As Long, lngheight As Long
Dim rightmost As Long, RightIndx As Integer
'
'Note : The Controls appearing in Detail Section from left to Right
'       is not indexed 0 to nn in the order of placing,
'       instead 1st control placed in the Section has index value 0
'       irrespective of its current position.
'
On Error GoTo Page_Footer_Err

Set cdb = CurrentDb
Set rptSection = obj.Section(acDetail)

ctrlCount = rptSection.Controls.Count - 1

lngleft = rptSection.Controls(0).Left
rightmost = rptSection.Controls(0).Left

'indexed 0 control may not be the leftmost control on the Form/Report
'so find the leftmost control's left value
For j = 0 To ctrlCount
 leftmost = rptSection.Controls(j).Left
 
 If leftmost < lngleft Then
   lngleft = leftmost
 End If
 If leftmost > rightmost Then
   rightmost = leftmost
   RightIndx = j
 End If
Next
 
lngtop = 0.0208 * 1440
lngWidth = 0: ctrwidth = 0

   lngWidth = rightmost + rptSection.Controls(RightIndx).Width
   lngWidth = lngWidth - lngleft
   
  Set LineCtrl = CreateReportControl(obj.Name, acLine, acPageFooter, "", "", lngleft, lngtop, lngWidth, 0)
  Set Ctrl = LineCtrl
  LineCtrl.BorderColor = 12632256
  LineCtrl.BorderWidth = 2
  LineCtrl.Name = "ULINE"
  
lngtop = 0.0418 * 1440
lngleft = LineCtrl.Left
lngWidth = 2 * 1440
lngheight = 0.229 * 1440

'draw Page No control at the Report footer
Set LineCtrl = CreateReportControl(obj.Name, acTextBox, acPageFooter, "", "", lngleft, lngtop, lngWidth, lngheight)
With LineCtrl
   .ControlSource = "='Page : ' & [page] & ' / ' & [pages]"
   .Name = "PageNo"
   .FontName = "Arial"
   .FontSize = 10
   .FontWeight = 700
   .TextAlign = 1
End With
'draw Date Control at the right edge of the Line Control
'calculate left position of Date control

lngleft = (LineCtrl.Left + Ctrl.Width) - lngWidth
Set LineCtrl = CreateReportControl(obj.Name, acTextBox, acPageFooter, "", "", lngleft, lngtop, lngWidth, lngheight)
With LineCtrl
   .ControlSource = "='Date : ' & Format(Date(),'dd/mm/yyyy')"
   .Name = "Dated"
   .FontName = "Arial"
   .FontSize = 10
   .FontWeight = 700
   .TextAlign = 3
End With

Page_Footer_Exit:
Exit Function

Page_Footer_Err:
MsgBox Err & ": " & Err.Description, "Page_Footer()"
Resume Page_Footer_Exit
End Function

Several Command Buttons are placed on both pages of the TabControl, and all their event subroutines are handled within the RWiz_CmdButton Wrapper Class.

On the second page, there is a Finish button (cmdReport) that triggers the Report Wizard’s main functions. Since all Wizard-related functions reside in the WizObject_Init Class Module, a separate Command Button instance (cmdFinish) is explicitly defined in that module to handle the cmdReport button’s operations.

Unlike the other Command Button instances, the cmdFinish instance is not added to the Collection object after its OnClick event is enabled. This ensures that its functionality remains isolated and directly tied to executing the Report Wizard’s core procedures.

The Click event subroutine for this Command Button is implemented in the WizObject_Init Class Module, allowing the Report Wizard functions to be called directly from within the module.

At the start of the Class_Init() subroutine, the Create_FilesList() function is executed to generate the ComboBox’s source list of tables and select queries. This is followed by the creation of ListBox and Command Button instances, enabling their events, and adding them to the Collection object.

When the cmdReport button is clicked, it calls the Report Creation Function. Although the Column Format Report is less commonly used, it remains useful for specialized purposes such as label printing.

The RWiz_CmdButton Class Module.

This Wrapper Class Module of CommandButton Object contains the following Command Button Click Event Subroutines.

Option Compare Database
Option Explicit

Private WithEvents cmd As CommandButton
Private frm As Form
Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String

Public Property Get w_Frm() As Form
    Set w_Frm = frm
End Property

Public Property Set w_Frm(ByRef wFrm As Form)
    Set frm = wFrm
End Property

Public Property Get w_cmd() As CommandButton
    Set w_cmd = cmd
End Property

Public Property Set w_cmd(ByRef wcmd As CommandButton)
    Set cmd = wcmd
End Property

Private Sub cmd_Click()
Dim lblInfo As String

  Select Case cmd.Name

    Case "cmdCancel2"
        DoCmd.Close acForm, frm.Name
               
    Case "cmdNext"
    If frm.SelList.listcount = 0 Then
        frm.cmdReport.Enabled = False
    Else
        frm.cmdReport.Enabled = True
    End If
    
  'Display the Wizard selection along with
  'the Table/Query selected in a Label Control
  'In the 2nd Page when the User Clicks
  'the cmdNext Command Button to display
  'the 2nd Page of the Wizard.
    lblInfo = "Table/Query: " & frm!FilesList
    If frm!WizList = 1 Then
        lblInfo = lblInfo & " - Column Report."
    Else
        lblInfo = lblInfo & " - Tabular Report."
    End If
    frm!info.Caption = lblInfo
    
 'Create the field List of the selected Table
 'and display them in the 1st ListBox on the
 '2nd Page of the Report Wizard.
       Call SelectTable
       
    Case "cmdCancel"
        DoCmd.Close acForm, frm.Name
        
    Case "cmdRight"
'Move the selected field to the Right=side ListBox.
'Multiselect option not given
        RightAll 1

    Case "cmdRightAll"
'Option Number Moves all the fields from
'Left side ListBox to the Right-side ListBox
        RightAll 2

    Case "cmdLeft"
        LeftAll 1
        
    Case "cmdLeftAll"
        LeftAll 2
    
    Case "cmdBack"
    'Go back to first Page. cancels the 2nd Page selections.
        frm.SelList.RowSource = "" 'Empty Selected field list
        frm.FilesList.RowSource = "WizQuery"
        frm.Page1.Visible = True
        frm.Page1.SetFocus
        frm.Page2.Visible = False
               
End Select
End Sub

Private Sub SelectTable()
Dim vizlist As ListBox
Dim lcount As Integer
Dim chkflag As Boolean
Dim FildList As ListBox
Dim strName As String
Dim strRSource As String
Dim cdb As DAO.Database
Dim doc As Document
Dim Tbl As DAO.TableDef
Dim Qry As DAO.QueryDef
Dim QryTyp As Integer
Dim FieldCount As Integer
Dim flag As Byte
Dim j As Integer

Set vizlist = frm.WizList
lcount = vizlist.listcount - 1

chkflag = False
For j = 0 To lcount
  If vizlist.Selected(j) = True Then
    xtyp = j + 1
    chkflag = True
  End If
Next

If IsNull(frm![FilesList]) = True Then
   MsgBox "Select a File from Table/Query List.", vbOKOnly + vbExclamation, "cmdNext"
   frm.WizList.Selected(0) = True
Else
   strFile = frm.FilesList
   frm.Page2.Visible = True
   frm.Page2.SetFocus
   frm.Page1.Visible = False
   
Set cdb = CurrentDb
flag = 0
For Each Tbl In cdb.TableDefs
    If Tbl.Name = strFile Then
       flag = 1
    End If
Next
For Each Qry In cdb.QueryDefs
    If Qry.Name = strFile Then
       flag = 2
    End If
Next
If flag = 1 Then
    Set Tbl = cdb.TableDefs(strFile)
    Set FildList = frm.FldList
    strRSource = ""
    FieldCount = Tbl.Fields.Count - 1
    For j = 0 To FieldCount
        If Len(strRSource) = 0 Then
            strRSource = Tbl.Fields(j).Name
        Else
            strRSource = strRSource & ";" & Tbl.Fields(j).Name
        End If
    Next
ElseIf flag = 2 Then
    Set Qry = cdb.QueryDefs(strFile)
    strRSource = ""
    FieldCount = Qry.Fields.Count - 1
    For j = 0 To FieldCount
        If Len(strRSource) = 0 Then
            strRSource = Qry.Fields(j).Name
        Else
            strRSource = strRSource & ";" & Qry.Fields(j).Name
        End If
    Next
End If

frm.FldList.RowSource = strRSource
frm.FldList.Requery
End If

End Sub

Private Function RightAll(ByVal SelectionType As Integer)
Dim FldList As ListBox, SelctList As ListBox, strRSource As String
Dim listcount As Long, j As Long, strRS2 As String

'On Error GoTo RightAll_Err
If SelectionType = 0 Then
   Exit Function
End If
Set FldList = Forms("ReportWizard").FldList
Set SelctList = Forms("ReportWizard").SelList

listcount = FldList.listcount - 1
strRSource = SelctList.RowSource: strRS2 = ""

Select Case SelectionType
    Case 1
        For j = 0 To listcount
            If FldList.Selected(j) = True Then
                If Len(strRSource) = 0 Then
                    strRSource = FldList.ItemData(j)
                Else
                    strRSource = strRSource & ";" & FldList.ItemData(j)
                End If
            Else
                If Len(strRS2) = 0 Then
                    strRS2 = FldList.ItemData(j)
                Else
                    strRS2 = strRS2 & ";" & FldList.ItemData(j)
                End If
            End If
        Next
        SelctList.RowSource = strRSource
        FldList.RowSource = strRS2
        SelctList.Requery
        FldList.Requery
    frm.cmdReport.Enabled = True
    Case 2

        For j = 0 To listcount
            If Len(strRSource) = 0 Then
                strRSource = FldList.ItemData(j)
            Else
                strRSource = strRSource & ";" & FldList.ItemData(j)
            End If
        Next
        SelctList.RowSource = strRSource
        FldList.RowSource = ""
        SelctList.Requery
        FldList.Requery
        frm.cmdCancel2.SetFocus
    If SelctList.listcount = 0 Then
        frm.cmdReport.Enabled = False
    End If
End Select
frm.cmdReport.Enabled = True

RightAll_Exit:
Exit Function

RightAll_Err:
MsgBox Err & ": " & Err.Description, , "RightAll"
Resume RightAll_Exit
End Function

Private Function LeftAll(ByVal SelectionType As Integer)
Dim FldList As ListBox, SelctList As ListBox, strRSource As String
Dim listcount As Long, j As Long, strRS2 As String

On Error GoTo LeftAll_Err

If SelectionType = 0 Then
   Exit Function
   
End If

Set FldList = Forms("ReportWizard").FldList
Set SelctList = Forms("ReportWizard").SelList

listcount = SelctList.listcount - 1
strRSource = FldList.RowSource: strRS2 = ""

Select Case SelectionType
    Case 1
        For j = 0 To listcount
            If SelctList.Selected(j) = True Then
                If Len(strRSource) = 0 Then
                    strRSource = SelctList.ItemData(j)
                Else
                    strRSource = strRSource & ";" & SelctList.ItemData(j)
                End If
            Else
                If Len(strRS2) = 0 Then
                    strRS2 = SelctList.ItemData(j)
                Else
                    strRS2 = strRS2 & ";" & SelctList.ItemData(j)
                End If
            End If
        Next
        SelctList.RowSource = strRS2
        FldList.RowSource = strRSource
        SelctList.Requery
        FldList.Requery
    If SelctList.listcount = 0 Then
        frm.cmdReport.Enabled = False
    End If
    Case 2
        For j = 0 To listcount
            If Len(strRSource) = 0 Then
                strRSource = SelctList.ItemData(j)
            Else
                strRSource = strRSource & ";" & SelctList.ItemData(j)
            End If
        Next
        SelctList.RowSource = ""
        FldList.RowSource = strRSource
        SelctList.Requery
        FldList.Requery
    If SelctList.listcount = 0 Then
        frm.cmdReport.Enabled = False
    End If
End Select
LeftAll_Exit:
Exit Function

LeftAll_Err:
MsgBox Err.Description, , "LeftAll"
Resume LeftAll_Exit

End Function

On the second page of the Report Wizard, a set of four Command Buttons positioned between the two ListBoxes controls the field selection and removal process:

Single Field Move ( > ) – Moves the currently selected field from the first ListBox to the second ListBox (one field at a time).
Move All Fields ( >> ) – Transfers all fields from the first ListBox to the second ListBox in a single operation.
Remove Single Field ( < ) – Removes the selected field from the second ListBox and places it back in the first ListBox.
Remove All Fields ( << ) – Clears all items from the second ListBox and restores them to the first ListBox at once.

Additionally, the Back Command Button clears all fields from the second ListBox and navigates back to the first page of the Report Wizard.

The RWiz_Combo Class Module Code

Option Compare Database
Option Explicit

Private cbofrm As Access.Form
Private WithEvents cbo As Access.ComboBox 'ComboBox object

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'ComboBox Wrapper Class
'Author: a.p.r. pillai
'Date  : 20/10/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cbo_Frm() As Form
    Set cbo_Frm = cbofrm
End Property

Public Property Set cbo_Frm(ByRef cfrm As Form)
    Set cbofrm = cfrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get c_cbo() As ComboBox
    Set c_cbo = cbo
End Property

Public Property Set c_cbo(ByRef pcbo As ComboBox)
    Set cbo = pcbo
End Property

Private Sub cbo_Click()
        cbofrm!FileList = Null

        cbofrm.TabCtl0.Pages(0).Visible = True
        cbofrm.TabCtl0.Pages(0).SetFocus
        cbofrm.TabCtl0.Pages(1).Visible = False
        cbofrm.TabCtl0.Pages(1).SetFocus
End Sub

Private Sub cbo_GotFocus()
    GFColor cbofrm, cbo
End Sub

Private Sub cbo_LostFocus()
    LFColor cbofrm, cbo
End Sub

The RWiz_ListBox Class Module Code.

Option Compare Database
Option Explicit

Private lstfrm As Access.Form
Private WithEvents lst As Access.ListBox

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'ListBox Wrapper Class
'Author: a.p.r. pillai
'Date  : 20/10/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get lst_Frm() As Form
    Set lst_Frm = lstfrm
End Property

Public Property Set lst_Frm(ByRef mFrm As Form)
    Set lstfrm = mFrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get m_lst() As ListBox
    Set m_lst = lst
End Property

Public Property Set m_lst(ByRef mLst As ListBox)
    Set lst = mLst
End Property

Private Sub lst_Click()
Dim i As Integer

Select Case lst.Name
    Case "WizList"
        'Code
    Case "FldList"
        'Code
    Case "SelList"
        'Code
End Select

End Sub

Private Sub lst_GotFocus()
    GFColor lstfrm, lst
End Sub

Private Sub lst_LostFocus()
    LFColor lstfrm, lst
End Sub

The ListBox and ComboBox Class Module Subroutine Code highlights the Control when these controls receive Focus.

The RWiz_TabCtl Class Module Code.

Option Compare Database
Option Explicit

Private tbFrm As Form
Private WithEvents tb As TabControl

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Tab Control Events
'Author: a.p.r. pillai
'Date  : 20/10/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

Public Property Get Tb_Frm() As Form
    Set Tb_Frm = tbFrm
End Property

Public Property Set Tb_Frm(ByRef mFrm As Form)
    Set tbFrm = mFrm
End Property

Public Property Get Tb_Tab() As TabControl
    Set Tb_Tab = tb
End Property

Public Property Set Tb_Tab(ByRef mTab As TabControl)
    Set tb = mTab
End Property

Private Sub tb_Change()
Select Case tb.Value
    Case 0
        'MsgBox "Change Event: TabCtl.Page(0)"
    Case 1
        'MsgBox "Change Event: TabCtl.Page(1)"
End Select
        
End Sub

The Wrapper Class Module also includes the TabPage_Change() Event. This was added primarily for completeness, but in the current implementation, it is not utilized for any specific functionality.

Download the Demo Database from the Link given below.

ReportWizard.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Custom Made Form Wizard VBA - 15

2023-10-09T14:52:00.012+05:30

Streamlined Custom-Made Form Wizard.

This blog post was originally published in December 2008 under Access 2003 and has now been updated to demonstrate the streamlined VBA coding approach using standalone Class Modules.

The Form Wizard in Access can generate two types of forms: Column Format and Tabular Format. But why create a custom Form Wizard when Access already includes built-in Form and Report Wizards?

My curiosity was sparked by the techniques employed in the built-in Form/Report Wizards. Moreover, the ability to create tabular forms with fixed-length fields is handy for customization, particularly when working with a large number of columns in an Access form or report.

The custom Form Wizard itself is designed with a TabControl containing two pages.

The First Page of the Wizard.

Right-click to open Large Image in New Tab/Window.

At the top of the Form Wizard, a ListBox allows you to select the Wizard Type—either Column Format or Tabular Format.

Just below it, a ComboBox displays a list of available Tables and Queries, retrieved from the database system tables through a query. These names are then added as the Row Source of the ComboBox for user selection.

The Query SQL is given below.

SELECT MSysObjects.Name
FROM MSysObjects
WHERE (((MSysObjects.Type)=1 Or (MSysObjects.Type)=5) AND ((Left([Name],4))<>'WizQ') AND ((Left([Name],1))<>'~') AND ((MSysObjects.Flags)=0))
ORDER BY MSysObjects.Type, MSysObjects.Name;

The options shown as selected in both the ListBox and ComboBox are set as defaults. However, you can change these selections before moving to the next step by clicking the Next command button.

The Second Wizard Page Image.

Right-click to open Large Image in New Tab/Window.

The fields from the selected Table or Query will be listed in the left-side ListBox control. You can add fields individually by selecting a field and clicking the > button. To include all fields at once, simply click the >> button.

Similarly, you can remove unwanted fields from the selected list by using the left-pointing < button to remove them one by one, or the << button to remove all fields at once. If no fields are selected, the Finish button will remain disabled.

Once the required fields are chosen, click the Finish button to generate the Form and open it in Normal View.

The FormWizard Form Module VBA Code.

Option Compare Database
Option Explicit

Private obj As New FWizObject_Init

Private Sub Form_Load()
    Set obj.fm_fom = Me
End Sub

The FWizObject_Init Class Module contains the list of object-level wrapper classes. The VBA code for the FWizObject_Init Class Module is provided below.

Option Compare Database
Option Explicit

Private fom As Access.Form

Private cmdb As FWiz_CmdButton
Private lstb As FWiz_ListBox
Private comb As FWiz_Combo

Private tb As FWiz_TabCtl
Private Coll As New Collection

'Wizard Functions Running Command Button Instance'
'Functions are placed in this Module
Private WithEvents cmdFinish As Access.CommandButton
Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String

Public Property Get fm_fom() As Form
  Set fm_fom = fom
End Property

Public Property Set fm_fom(ByRef mfom As Form)
  Set fom = mfom
    
  Call Class_Init
End Property

Private Sub Class_Init()
Dim Ctl As Control
Const EP = "[Event Procedure]"

'Filter Table/Select Query Names for ComboBox
Call Create_FilesList

For Each Ctl In fom.Controls
    Select Case Ctl.ControlType
        Case acTabCtl
            Set tb = New FWiz_TabCtl
            Set tb.Tb_Frm = fom
            Set tb.Tb_Tab = Ctl
              tb.Tb_Tab.OnChange = EP
              
              Coll.Add tb
            Set tb = Nothing
        
        Case acCommandButton
            Select Case Ctl.Name
                Case "cmdForm"
                    'Not to add in the Collection object
                    'The Click Event Runs the Wizard Functions
                    'from this Class Module, not from the
                    'Wrapper Class - FWiz_CmdButton
                    
                    Set cmdFinish = fom.cmdForm
                    cmdFinish.OnClick = EP
                Case Else
            
            Set cmdb = New FWiz_CmdButton
            Set cmdb.w_Frm = fom
            Set cmdb.w_cmd = Ctl
                cmdb.w_cmd.OnClick = EP
                
              Coll.Add cmdb
            Set cmdb = Nothing
         End Select
            
        Case acComboBox
            Set comb = New FWiz_Combo
            Set comb.cbo_Frm = fom
            Set comb.c_cbo = Ctl
                comb.c_cbo.OnGotFocus = EP
                comb.c_cbo.OnLostFocus = EP
            
        Case acListBox
            Set lstb = New FWiz_ListBox
            Set lstb.lst_Frm = fom
            Set lstb.m_lst = Ctl
                lstb.m_lst.OnGotFocus = EP
                lstb.m_lst.OnLostFocus = EP
                
                Coll.Add lstb
            Set lstb = Nothing
    End Select
Next
            
End Sub

Private Sub cmdFinish_Click()
        xtyp = fom!WizList
        strFile = fom!FilesList
        If xtyp = 1 Then
            Columns strFile
        Else
            Tabular strFile
        End If
          DoCmd.Close acForm, fom.Name
End Sub

'Create Tables/Queries List for
Private Sub Create_FilesList()
Dim strSQL1 As String
Dim cdb As DAO.Database
Dim Qry As DAO.QueryDef
Dim FList As ComboBox

On Error GoTo Create_FilesList_Err
DoCmd.Restore

strSQL1 = "SELECT MSysObjects.Name " _
& "FROM MSysObjects " _
& "WHERE (((MSysObjects.Type)=1 Or (MSysObjects.Type)=5) " _
& "AND ((Left([Name],4))<>'WizQ') AND ((Left([Name],1))<>'~') " _
& "AND ((MSysObjects.Flags)=0)) " _
& "ORDER BY MSysObjects.Type, MSysObjects.Name;"

DarkBlue = 8388608
twips = 1440

Set cdb = CurrentDb
Set Qry = cdb.QueryDefs("WizQuery")
If Err = 3265 Then
  Set Qry = cdb.CreateQueryDef("WizQuery")
  Qry.SQL = strSQL1
  cdb.QueryDefs.Append Qry
  cdb.QueryDefs.Refresh
  Err.Clear
End If

With Forms("FormWizard")
Set FList = .FilesList
    .FilesList.RowSource = "WizQuery"
    .FilesList.Requery
End With

Create_FilesList_Exit:
Exit Sub

Create_FilesList_Err:
MsgBox Err & ": " & Err.Description, , "Create_FilesList()"
Resume Create_FilesList_Exit
End Sub

'Wizard Functions
Private Function Columns(ByVal DataSource As String)
'-------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : Sept-2000
'URL    : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'-------------------------------------------------------------------
Dim cdb As Database
Dim FldList() As String
Dim Ctrl As Control
Dim frm As Form
Dim HdSection As Section
Dim DetSection As Section
Dim FrmFields As ListBox

Dim lngTxtLeft As Long
Dim lngTxtTop As Long
Dim lngTxtHeight As Long
Dim lngtxtwidth As Long

Dim lngLblLeft As Long
Dim lngLblTop As Long
Dim lngLblHeight As Long
Dim lngLblWidth As Long

Dim FldCheck As Boolean
Dim strTblQry As String
Dim intflds As Integer
Dim lstcount As Long
Dim j As Integer

'Create Form with Selected Fields
On Error GoTo Columns_Err

strFile = DataSource

Set FrmFields = Forms("FormWizard").SelList
lstcount = FrmFields.listcount

If lstcount = 0 Then
   MsgBox "Fields Not Selected for Form", , "FormWizard"
   Exit Function
Else
   lstcount = lstcount - 1
End If

ReDim FldList(0 To lstcount) As String

Set cdb = CurrentDb
Set frm = CreateForm
Application.RunCommand acCmdFormHdrFtr
With frm
    .DefaultView = 0
    .ViewsAllowed = 0
    .DividingLines = False
    .Section(acFooter).Visible = True
    .Section(acFooter).Height = 0.1667 * twips '0.1667 Inches
    .Section(acHeader).DisplayWhen = 0
    .Section(acHeader).Height = 0.5 * twips '0.5 Inches
End With

Set HdSection = frm.Section(acHeader)
    HdSection.Height = 0.6667 * twips

Set DetSection = frm.Section(acDetail)
    DetSection.Height = 0.166 * twips


For j = 0 To lstcount
  FldList(j) = FrmFields.ItemData(j)
Next

With frm
    .RecordSource = strFile
    .Caption = strFile

    lngtxtwidth = 1.25 * twips
    lngTxtLeft = 1.6694 * twips
    lngTxtTop = 0
    lngTxtHeight = 0.21 * twips

    lngLblLeft = 0.073 * twips
    lngLblTop = 0 '0.5 * twips
    lngLblWidth = 1.5208 * twips
    lngLblHeight = lngTxtHeight
End With

For j = 0 To lstcount

'Create Field Child Label
   Set Ctrl = CreateControl(frm.Name, acLabel, acDetail, _
   FldList(j), FldList(j), lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
    With Ctrl
       .Caption = FldList(j)
       .Name = FldList(j) & " Label"
       .Width = 1.5208 * twips
       .ForeColor = 0
       .BorderColor = 0
       .BorderStyle = 0
       .FontWeight = 400 ' Normal 700 ' Bold
       Select Case (1 / 9)
            Case 1, 2, 3
                lngLblTop = 0
                lngLblLeft = lngLblLeft + (2.7083 * twips)
            Case Else
                lngLblTop = lngLblTop + .Height + (0.1 * 1440)
       End Select
    End With

'Create Field TextBox
   Set Ctrl = CreateControl(frm.Name, acTextBox, acDetail, , _
   FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
    With Ctrl
       .ControlSource = FldList(j)
       .FontName = "Arial"
       .FontSize = 10
       .Name = FldList(j)
       .BackColor = RGB(255, 255, 255)
       .ForeColor = 0
       .BorderColor = 9868950
       .BorderStyle = 1
       .SpecialEffect = 2
       
       Select Case (j / 9)
            Case 1, 2, 3
                lngTxtTop = 0
                lngTxtLeft = lngTxtLeft + (3.7084 * twips)
       Case Else
                lngTxtTop = lngTxtTop + .Height + (0.1 * twips)
       End Select
    End With

Next

'Create Heading Label
Call CreateHeading(frm)

Columns_Exit:
Exit Function

Columns_Err:
MsgBox Err.Description, , "Columns()"
Resume Columns_Exit
End Function


Private Function Tabular(ByVal DataSource As String)
'-------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : Sept-2000
'URL    : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'-------------------------------------------------------------------
Dim cdb As Database
Dim FldList() As String
Dim Ctrl As Control
Dim frm As Form
Dim HdSection As Section
Dim DetSection As Section

Dim lngTxtLeft As Long
Dim lngTxtTop As Long
Dim lngTxtHeight As Long
Dim lngtxtwidth As Long

Dim lngLblLeft As Long
Dim lngLblTop As Long
Dim lngLblHeight As Long
Dim lngLblWidth As Long

Dim FldCheck As Boolean
Dim strTblQry As String
Dim intflds As Integer
Dim lstcount As Long
Dim FrmFields As ListBox
Dim j As Integer

'Create Form with Selected Fields
strFile = DataSource
On Error GoTo Tabular_Err

Set FrmFields = Forms("FormWizard").SelList
lstcount = FrmFields.listcount

If lstcount = 0 Then
   MsgBox "Fields Not Selected for the Form"
   Exit Function
Else
   lstcount = lstcount - 1
End If

ReDim FldList(0 To lstcount) As String

Set cdb = CurrentDb
Set frm = CreateForm
Application.RunCommand acCmdFormHdrFtr

With frm
    .DefaultView = 1
    .ViewsAllowed = 0
    .DividingLines = False
    .Section(acFooter).Visible = True
    .Section(acHeader).DisplayWhen = 0
    .Section(acHeader).Height = 0.5 * 1440
    .Section(acFooter).Height = 0.1667 * 1440
End With

Set HdSection = frm.Section(acHeader)
    HdSection.Height = 0.6667 * twips

Set DetSection = frm.Section(acDetail)
    DetSection.Height = 0.166 * twips


For j = 0 To lstcount
  FldList(j) = FrmFields.ItemData(j)
Next

With frm
    .Caption = strFile
    .RecordSource = strFile
    lngtxtwidth = 0.5 * twips 'Inches
    lngTxtLeft = 0.073 * twips
    lngTxtTop = 0
    lngTxtHeight = 0.166 * twips

    lngLblWidth = lngtxtwidth
    lngLblLeft = lngTxtLeft
    lngLblTop = 0.5 * twips
    lngLblHeight = lngTxtHeight
End With

For j = 0 To lstcount
 
'Create Fields in the Detail Section
   Set Ctrl = CreateControl(frm.Name, acTextBox, acDetail, , _
   FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
    
    With Ctrl
       .ControlSource = FldList(j)
       .Name = FldList(j)
       .FontName = "Verdana"
       .Width = (0.5 * twips) 'Inches
       .FontSize = 8
       .ForeColor = 0
       .BorderColor = 12632256
       .BackColor = 16777215
       .BorderStyle = 1
       .SpecialEffect = 0
       lngTxtLeft = lngTxtLeft + (0.5 * twips)
    End With
   
'Field Heading Labels
   Set Ctrl = CreateControl(frm.Name, acLabel, acHeader, , _
   FldList(j), lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
    
    With Ctrl
       .Caption = FldList(j)
       .Name = FldList(j) & " Label"
       .Width = (0.5 * twips)
       .ForeColor = DarkBlue
       .BorderColor = DarkBlue
       .BorderStyle = 1
       .FontWeight = 700 ' Bold
       lngLblLeft = lngLblLeft + (0.5 * twips)
    End With
Next

'Heading Label
Call CreateHeading(frm)

Tabular_Exit:
Exit Function

Tabular_Err:
MsgBox Err & ": " & Err.Description, , "Tabular()"
Resume Tabular_Exit
End Function

Private Function CreateHeading(ByRef hFrm As Form)
Dim Ctl As Control
Dim lngLblLeft As Long
Dim lngLblTop As Long
Dim lngLblWidth As Long
Dim lngLblHeight As Long

On Error GoTo CreateHeading_Err

lngLblLeft = 0.073 * twips
lngLblTop = 0.0521 * twips
lngLblWidth = 1.5208 * twips
lngLblHeight = 0.323 & twips

'Create Heading Label
 Set Ctl = CreateControl(hFrm.Name, acLabel, acHeader, , _
 "Head1", lngLblLeft, lngLblTop, lngLblWidth, lngLblHeight)
   
   With Ctl
        .Caption = strFile
        .TextAlign = 2
        .Width = 4.5 * twips
        .Height = 0.38 * twips
        
        .ForeColor = DarkBlue
        .BorderStyle = 0
        .BorderColor = DarkBlue
        
        .FontName = "Arial"
        .FontSize = 18
        .FontWeight = 700 ' Bold
        .FontItalic = True
        .FontUnderline = True
   End With
   
DoCmd.OpenForm hFrm.Name, acNormal

CreateHeading_Exit:
Exit Function

CreateHeading_Err:
MsgBox Err & ": " & Err.Description, , "CreateHeading()"
Resume CreateHeading_Exit

End Function

A separate Command Button instance named cmdFinish is created in the intermediate Class Module FWizObject_Init to execute all the Wizard-related functions defined in the main Class Module. The cmdFinish_Click() event procedure serves as the entry point for running these Wizard functions.Private Sub cmdFinish_Click()

        xtyp = fom!WizList
        strFile = fom!FilesList
        If xtyp = 1 Then
            Columns strFile
        Else
            Tabular strFile
        End If
          DoCmd.Close acForm, fom.Name 'Closes the Wizard Form.
End Sub

Sample Form Images, both Column and Tabular Forms, are created using the Categories Table given below.

Wizard Created Form in Column Format.

Right-click to open Large Image in New Tab/Window.

Wizard Form in Tabular Format with Categories Table.

Right-click to open Large Image in New Tab/Window.

The Tabular Form is created with fixed-width Fields and needs to be modified with the required width of each Field.

The Command Buttons Wrapper Class: FWiz_CmdButton VBA Code.

The FWiz_CmdButton Class Module contains the Command Button wrapper code and is provided below for your reference. Other related wrapper classes include only a few lines of event procedure code. You may open these Class Modules directly in the attached demo database to review and study their implementation in detail.

Option Compare Database
Option Explicit

Private WithEvents cmd As CommandButton
Private frm As Form
Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String

Public Property Get w_Frm() As Form
    Set w_Frm = frm
End Property

Public Property Set w_Frm(ByRef wFrm As Form)
    Set frm = wFrm
End Property

Public Property Get w_cmd() As CommandButton
    Set w_cmd = cmd
End Property

Public Property Set w_cmd(ByRef wcmd As CommandButton)
    Set cmd = wcmd
End Property

Private Sub cmd_Click()
Dim lblInfo As String

  Select Case cmd.Name

    Case "cmdCancel2"
        DoCmd.Close acForm, frm.Name
               
    Case "cmdNext"
    If frm.SelList.listcount = 0 Then
        frm.cmdForm.Enabled = False
    Else
        frm.cmdForm.Enabled = True
    End If
    
    lblInfo = "Table/Query: " & frm!FilesList
    If frm!WizList = 1 Then
        lblInfo = lblInfo & " - Columnar Form."
    Else
        lblInfo = lblInfo & " - Tabular Form."
    End If
    frm!info.Caption = lblInfo
       Call SelectTable
       
    Case "cmdCancel"
        DoCmd.Close acForm, frm.Name
        
    Case "cmdRight"
        RightAll 1

    Case "cmdRightAll"
        RightAll 2

    Case "cmdLeft"
        LeftAll 1
        
    Case "cmdLeftAll"
        LeftAll 2
    
    Case "cmdBack"
        frm.FilesList.RowSource = "WizQuery"
        frm.Page1.Visible = True
        frm.Page1.SetFocus
        frm.Page2.Visible = False
               
End Select
End Sub

Private Sub SelectTable()
Dim vizlist As ListBox, lcount As Integer, chkflag As Boolean
Dim FildList As ListBox, strName As String, strRSource As String
Dim cdb As Database, doc As Document
Dim Tbl As TableDef, Qry As QueryDef, QryTyp As Integer
Dim flag As Byte, FieldCount As Integer, j As Integer

Set vizlist = frm.WizList
lcount = vizlist.listcount - 1

chkflag = False
For j = 0 To lcount
  If vizlist.Selected(j) = True Then
    xtyp = j + 1
    chkflag = True
  End If
Next

If IsNull(frm![FilesList]) = True Then
   MsgBox "Select a File from Table/Query List.", vbOKOnly + vbExclamation, "cmdNext"
   frm.WizList.Selected(0) = True
Else
   strFile = frm.FilesList
   frm.Page2.Visible = True
   frm.Page2.SetFocus
   frm.Page1.Visible = False
   
Set cdb = CurrentDb
flag = 0
For Each Tbl In cdb.TableDefs
    If Tbl.Name = strFile Then
       flag = 1
    End If
Next
For Each Qry In cdb.QueryDefs
    If Qry.Name = strFile Then
       flag = 2
    End If
Next
If flag = 1 Then
    Set Tbl = cdb.TableDefs(strFile)
    Set FildList = frm.FldList
    strRSource = ""
    FieldCount = Tbl.Fields.Count - 1
    For j = 0 To FieldCount
        If Len(strRSource) = 0 Then
            strRSource = Tbl.Fields(j).Name
        Else
            strRSource = strRSource & ";" & Tbl.Fields(j).Name
        End If
    Next
ElseIf flag = 2 Then
    Set Qry = cdb.QueryDefs(strFile)
    strRSource = ""
    FieldCount = Qry.Fields.Count - 1
    For j = 0 To FieldCount
        If Len(strRSource) = 0 Then
            strRSource = Qry.Fields(j).Name
        Else
            strRSource = strRSource & ";" & Qry.Fields(j).Name
        End If
    Next
End If

frm.FldList.RowSource = strRSource
frm.FldList.Requery
End If

End Sub

Private Function RightAll(ByVal SelectionType As Integer)
Dim FldList As ListBox, SelctList As ListBox, strRSource As String
Dim listcount As Long, j As Long, strRS2 As String

On Error GoTo RightAll_Err
If SelectionType = 0 Then
   Exit Function
End If
Set FldList = Forms("FormWizard").FldList
Set SelctList = Forms("FormWizard").SelList

listcount = FldList.listcount - 1
strRSource = SelctList.RowSource: strRS2 = ""

Select Case SelectionType
    Case 1
        For j = 0 To listcount
            If FldList.Selected(j) = True Then
                If Len(strRSource) = 0 Then
                    strRSource = FldList.ItemData(j)
                Else
                    strRSource = strRSource & ";" & FldList.ItemData(j)
                End If
            Else
                If Len(strRS2) = 0 Then
                    strRS2 = FldList.ItemData(j)
                Else
                    strRS2 = strRS2 & ";" & FldList.ItemData(j)
                End If
            End If
        Next
        SelctList.RowSource = strRSource
        FldList.RowSource = strRS2
        SelctList.Requery
        FldList.Requery
    frm.cmdForm.Enabled = True
    Case 2

        For j = 0 To listcount
            If Len(strRSource) = 0 Then
                strRSource = FldList.ItemData(j)
            Else
                strRSource = strRSource & ";" & FldList.ItemData(j)
            End If
        Next
        SelctList.RowSource = strRSource
        FldList.RowSource = ""
        SelctList.Requery
        FldList.Requery
    frm.cmdForm.Enabled = False
End Select
frm.cmdForm.Enabled = True

RightAll_Exit:
Exit Function

RightAll_Err:
MsgBox Err.Description, , "RightAll"
Resume RightAll_Exit
End Function

Private Function LeftAll(ByVal SelectionType As Integer)
Dim FldList As ListBox, SelctList As ListBox, strRSource As String
Dim listcount As Long, j As Long, strRS2 As String

On Error GoTo LeftAll_Err

If SelectionType = 0 Then
   Exit Function
   
End If

Set FldList = Forms("FormWizard").FldList
Set SelctList = Forms("FormWizard").SelList

listcount = SelctList.listcount - 1
strRSource = FldList.RowSource: strRS2 = ""

Select Case SelectionType
    Case 1
        For j = 0 To listcount
            If SelctList.Selected(j) = True Then
                If Len(strRSource) = 0 Then
                    strRSource = SelctList.ItemData(j)
                Else
                    strRSource = strRSource & ";" & SelctList.ItemData(j)
                End If
            Else
                If Len(strRS2) = 0 Then
                    strRS2 = SelctList.ItemData(j)
                Else
                    strRS2 = strRS2 & ";" & SelctList.ItemData(j)
                End If
            End If
        Next
        SelctList.RowSource = strRS2
        FldList.RowSource = strRSource
        SelctList.Requery
        FldList.Requery
    If SelctList.listcount = 0 Then
        frm.cmdForm.Enabled = False
    End If
    Case 2
        For j = 0 To listcount
            If Len(strRSource) = 0 Then
                strRSource = SelctList.ItemData(j)
            Else
                strRSource = strRSource & ";" & SelctList.ItemData(j)
            End If
        Next
        SelctList.RowSource = ""
        FldList.RowSource = strRSource
        SelctList.Requery
        FldList.Requery
    If SelctList.listcount = 0 Then
        frm.cmdForm.Enabled = False
    End If
End Select
LeftAll_Exit:
Exit Function

LeftAll_Err:
MsgBox Err.Description, , "LeftAll"
Resume LeftAll_Exit

End Function

Demo Database Download Link:

FormWizard1.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form Module Code Part 14

2023-09-30T21:17:00.020+05:30

All Frequently Used Controls on a Form.

We have learned how to capture events fired by Form or Report controls and handle them through Event Subroutines in their respective Wrapper Classes. The control Wrapper Class Instances created are assigned with the References of the actual controls on the Form, allowing us to interact with them seamlessly. Beyond event handling, any other control on the Form can also be accessed from the Wrapper Class to read or update its values. This flexibility opens the door to creative features such as running animations, simulating a digital clock on the Form, implementing a countdown timer before closing the Form, and much more.

For such activities, every Wrapper Class includes a Form object instance, to which the active Form’s reference is assigned. This allows the Wrapper Class to interact directly with the Form. When you need to handle events such as the Form_Timer() Event or the MouseMove Event on the Form’s Detail Section, the Form instance must be declared with the WithEvents keyword inside the Wrapper Class. Since the Form instance is always included, any of the above-mentioned features can be triggered from within any control’s Wrapper Class. However, if capturing Form-level events is not required, the instance can be declared without WithEvents.

The Form Detail Section declaration is as given below:

Private frm as Access.Form
Private WithEvents SecDetail As Access.Section

Set SecDetail = frm.Section(acDetail)
	SecDetail.OnMouseMove = "[Event Procedure]"

Report Detail Section Declaration and Reference assignments are like the following:

Private WithEvents Rpt as Access.Report
Private WithEvents RptSec as Access.[_SectionInReport]

Set RptSec = Rpt.Section(acDetail)

By moving Event Subroutine VBA Code out of the Form and Report modules and placing it in standalone Class Modules, we can work with the code independently while keeping the design surface clean. The Collection object plays a key role here, as it allows multiple instances of the same control type (such as TextBox controls on a Form) to remain in memory, each enabled with the required Events. This approach keeps the Form design process separate from the coding task, making both development and maintenance more efficient.

Episode Seven is a classic example that demonstrates the strength of this new approach—shifting Form/Report module code into standalone Class Modules. With this method, repetitive manual coding is greatly reduced. For instance, a single pair of GotFocus() and LostFocus() routines can manage any number of TextBoxes on a Form, without writing separate code for each one. Likewise, if ten TextBoxes require AfterUpdate() Event Subroutines, each with different validation rules, all of them can be handled within a single AfterUpdate() procedure in the standalone Class Module. This principle is not limited to TextBoxes—it applies uniformly to all types of controls on the Form.

Event Procedure code becomes better organized when placed in Wrapper Classes, making it easier to maintain and debug—without interfering with the Form’s design.

Private Sub Txt_AfterUpdate()
  Select Case Txt.Name
  	 Case "Quantity"
     	'Code
     Case "UnitPrice"
     	'Code
     Case "TaxRate"
     	'Code
     Case . . .
     
  End Select
End Sub

If any TextBox’s AfterUpdate event code needs modification, or if a new TextBox requires an AfterUpdate event subroutine, there is no need to open the Form in Design View, locate the TextBox control, open the Property Sheet, find the event property, and then click the Build… button to access the event procedure. Instead, we can simply open the Class Module directly and make the necessary changes. Compare this with the traditional approach, where developers often waste considerable time repeating the same steps for each control event, sometimes multiple times for the same control.

I am confident you will recognize the difference once you adopt this new coding approach. While it may take a little time to become familiar with the concept—especially if you are new to VBA development—the benefits in efficiency and maintainability are well worth the effort.

The Form shown below incorporates several controls that were designed in earlier episodes, with their corresponding Wrapper Class Modules imported to handle the control event procedures. In addition, animations such as scrolling text, a digital clock, and a countdown timer (displayed before the form closes) have been implemented within the Class Module to run seamlessly on the Form.

Everything you can do in a Form Module can also be achieved from a standalone Class Module. The real advantage comes when you shift your mindset to this approach—working differently, more effortlessly, and in a well-organized manner, with the added benefit of reusing your VBA code across projects, often with little or no modification. Once you experience this, the difference becomes clear.

Anything attempted for the first time feels difficult—that’s how most of us began our journey with VBA coding, spending countless minutes or even hours solving problems through trial and error. I retired from service 13 years ago, yet I continue to learn new things every day and share my experiences with others. Learning never truly stops; in fact, it becomes even more meaningful when we pass it on to others.

Technology is advancing at an incredible pace, and it is inspiring to see children as young as 10 to 15 years old already practicing coding and building apps. What once took us years to discover, they now explore at such an early age—truly fortunate learners of this generation!

I was first introduced to computer-related automation at the age of 27, during my service in the Indian Navy Defence Establishment. My initial exposure came through the Key Punch Machine, where I worked on panel wiring to automate tasks such as skipping or duplicating specific columns of an 80-column punch card—the standard input medium for programs and data at that time.

The mainframe system we used was an ICL 1901, equipped with disk drives, and the programming languages of choice were COBOL and FORTRAN. I even managed to learn a bit of COBOL back then, in 1975, which became my earliest step into the world of programming.

If you need some Class Module beginner lessons, they are available starting with this Link: MS-Access Class Modules and VBA series of a few Articles.

The Demo Database With All Frequently Used Controls.

The attached sample Demo Database contains the following Form; the download link is available at the end of this page, and the main Form (frmControls_All) Image is given below.

Right-click to open Large Image in New Tab/Window.

On the top-left side, the form features a TabControl-based menu designed with three layers of options, each hosted on separate Tab Pages. To achieve a clean interface, the Tab Page style is hidden by setting its property to None. Navigation between these menu pages is handled through dedicated command button clicks. Each button triggers a TabPage Change event, which in turn displays a message showing the corresponding Page Index number.

The three available menus are Tables, Forms, and Reports. The TabControl, along with its associated menu selection command buttons, was copied from the earlier episode’s form and pasted into this one. Some menu options were modified to replace them with other Forms and Reports introduced in previous episodes. The corresponding Class Modules were also imported into this database to ensure proper execution of these features.

Imported Class Modules of TabControl and the Menu changing Command Buttons.

The following Class Modules were imported into this Database, from an earlier episode, to run the Menu options with a few changes:

TabLst_Object_Init
TabLst_CmdButton
TabLst_ListBox
TabLst_TabCtl

The Tab Page with the name TABLES has three options: Employees, Orders, and Customer Tables. Double-click on an Item to open it. Before opening the Table, a Female Voice will announce the Table Name before it appears on the Screen.

Employees and Orders Form.

On the FORMS TabPage, the first option is the Employees Form with an embedded Orders SubForm. In the footer section of the Employees Form, you will find a Search and Find TextBox that allows you to look up records using the EmployeeID as the search key. When a search is performed, a label will briefly flash for a few seconds to indicate whether the search was successful or not. For testing, try entering an EmployeeID greater than 9—this will demonstrate the “not found” result.

Right-click to open Large Image in New Tab/Window.

Note: You may try to implement the Female Voice to announce the success or failure of the search operation.

The above Form and its VBA Codes are running from the following Class Modules, with the Emp Prefixes:

EmpObject_Init
EmpCmdButton
EmpTextBox
EmpCombo

The Employee-wise Orders Freight Sales Analysis.

The second option on the Forms Menu is the Employee-wise Orders Freight-Sales Analysis Form (frm_OptionGroup2), which includes a Graph Chart for visual analysis. This form features an Option Group Control with three selectable options:

Highest Freight Sales Value
Lowest Freight Sales Value
Total Freight Sales Value

Based on the selected option, the corresponding result is displayed in a TextBox, accompanied by an animated label caption—a scrolling text that moves from right to left for added visual effect.

Right-click to open Large Image in New Tab/Window.

The above form is powered by two standalone Class Modules, as shown below. Both the Form and the Class Modules have been imported from one of the earlier episodes.

Opt_Object_Init
Opt_Frame2

The Option Group Subroutine VBA code is executed from the Opt_Frame2 Class Module. The Employee ComboBox, the Freight Value display TextBox, and the Command Button Click Event Subroutines are handled through the Opt_Object_Init Class Module. Since each of these controls has only a single instance on the form, separate Wrapper Classes were not created for them. The Graph Chart on the Form.

The Graph Chart’s source data comes from the OrderSummaryQ2 query, which in turn is based on the OrderDetailQ2 query. The OrderDetailQ2 query filters data from the Orders table using the EmployeeID selected in the cboEmp ComboBox. A hidden TextBox named EID contains the expression =[cboEmp], which copies the EmployeeID selected in cboEmp. This value is then used in the Link Master Field property of the Graph Chart to dynamically update the chart whenever a different EmployeeID is chosen from the ComboBox.

The third TabControl page contains three report options:

Employee Records
Students Exam – Failed Cases (highlighted)
Students Passed/Failed Listing (from the same report)

The last two reports, along with their corresponding Class Modules, have been imported into this database from earlier episodes. The following stand-alone Class Modules handle the Event Subroutine VBA code for these reports:

ClsStudentHighlight0
ClsStudentsList

The ClsStudentHighlight0 Class Module runs the Detail_Print Event Subroutine Code for the Report StudentsHighlight_Class0.

The Report Image is given below:

Right-click to open Large Image in New Tab/Window.

The ClsStudentsList Class Module runs the Detail_Format() and Report_Page() event subroutines. Additionally, the PageBorder() function is called from the Standard Module to draw two border lines on each page of the report. An ellipse is also drawn around the TextBox in the Detail_Print() event of the report.

The Students Exam Passed List Image is given below.

Right-click to open Large Image in New Tab/Window.

The Exam Failed Cases Listing is generated from the same report. Both listings are created by hiding the Report Detail section for records that do not meet the specified criteria, controlled through the Detail_Format() event.

Right-click to open Large Image in New Tab/Window.

The SubForm on the Main Form.

Next, a SubForm contains three TextBoxes. The Quantity TextBox accepts values only in the range of 1 to 10, while the Unit Price TextBox must contain a non-zero value. These entries are validated in the OnExit() event subroutine of the ClsText Class Module before being accepted. The TotalPrice TextBox uses its OnGotFocus() event subroutine to calculate the total price (Quantity * UnitPrice) and populate the result into the TextBox. This calculated value is also displayed in the Label control positioned above the SubForm.

The SubForm is introduced here to demonstrate how to scan its controls and enable the required events within the Class_Init() subroutine of the ClsControls_All Class Module. This process is handled through two For...Next loops. The first loop begins with the statement:

For Each ctl In fom.mySubForm.Form.Controls

For the SubForm scanning, and the other starts with:

For Each ctl In fom.Controls

to scan for the required controls and enable their Event Procedures.

Note: If you place any TextBox on the TabControl pages, they are still treated as part of the main Form. Ensure that their names do not conflict with other TextBox names already present on the Form.

The Form contains a ComboBox with a list of country names. When a country is selected, its list index number is used to automatically select the corresponding capital city in the ListBox. Additionally, clicking an item in the ListBox will display the selected value in a message box, confirming that the Click event is being captured in the Class Module.

The Option Group Control.

The Option Group control is not linked to any specific function. However, when a radio button is clicked, it displays the index number of the selected option. This serves as confirmation that the event has been fired and successfully captured in the Option Group Class Module ClsOption.

The Employee Orders command button opens the form containing the Graph Chart (included in the TabControl menu) directly. The next button, labeled Heading Color, changes the ForeColor property of the form’s heading label.

The Close button triggers a 10-second countdown on the label positioned above the SubForm. Once the countdown reaches zero, the form frmControls_All automatically closes.

The Class Modules associated with the main form controls are named with the prefix Cls….

You can view the complete list of these Class Modules in the declaration section of the ClsControls_All Class Module.

Private tx As ClsText
Private cmd As ClsCmdButton
Private cbo As Clscombo
Private Lst As ClsListBox
Private Opt As ClsOption

Demo Database Download Link:

MixAllControls.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Report Module in Class Module-2

2023-09-23T08:39:00.019+05:30

Introduction.

Hiding Report Lines Conditionally.

Last week, we demonstrated that the code for highlighting Report lines in the Report Print Event can be moved into a standalone Class Module and executed from there whenever the Report is PrintPreviewed or printed.

To visually emphasize specific Report line records that do not meet the required marks criteria, a red ellipse is drawn around the corresponding TextBox. Traditionally, this procedure is implemented directly in the Detail_Print Event Subroutine within the Report’s Class Module. The Report Detail_Format, Report_Page Events.

The Report Detail Section Format Event runs before the Print Event. During this phase, the Report Detail Format Event arranges the data records line by line within the Detail section.

Other events, such as the Report Header, Report Footer, Page Header, Page Footer, and Report Page Events, also occur during the formatting phase. When these Section events are enabled, code can be written within them to control or manipulate the layout and appearance of the Report.

In this example, we will explore some new techniques in the Detail_Format Event of the Report. Instead of highlighting the failed cases with a red ellipse around the obtained marks, as we did in the previous episode, we will use this method to print the Report in two separate categories from the same data set.

Exam Passed Students Listing.
Exam Failed Students Listing.

Both listings will be generated from the same Report, based on one of the option selections mentioned earlier.

Of course, this could also be achieved more easily by other means, such as passing a value via OpenArgs to filter the Report records, or by setting the Query criteria based on a Form-based TextBox value when launching the Report. However, using the Detail Section Format Event to accomplish this allows you to see an alternative approach. Exploring different methods is both educational and practical—you’ll learn that there’s often more than one way to achieve the desired result.

The Report Listing image for the Exam Passed Cases Option above is given below:

Right-click to open Large Image in New Tab/Window.

The Exam Failed Cases Listing.

Right-click to open Large Image in New Tab/Window.

The Report Launching Form Image.

Right-click to open Large Image in New Tab/Window.

The left-side Command Button launches the Report using the traditional coding within the Report Module itself. In this mode, the Report page is drawn with a double-lined border.

Since there are three Command Buttons on the Main Form, we created a Wrapper Class ClsCmdButton to handle the launching of Reports. The VBA code for the ClsCmdButton class is shown below:

Option Compare Database
Option Explicit

Private cmdfrm As Form
Private WithEvents cmdNor As CommandButton 'For Normal Report Module Coded Report launching
Private WithEvents cmdCls As CommandButton 'Report Module Code in Class Module
Private WithEvents cmdQuit As CommandButton'Close the Main Form
Dim Opt As Variant
Dim param As String

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Command Button Events
'Author: a.p.r. pillai
'Date  : 22/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cmd_Frm() As Form
    Set cmd_Frm = cmdfrm
End Property

Public Property Set cmd_Frm(ByRef cfrm As Form)
    Set cmdfrm = cfrm
    Call class_Init
End Property

Private Sub class_Init()
Const EP = "[Event Procedure]"
    Set cmdNor = cmdfrm.cmdNormal
        cmdNor.OnClick = EP
        
    Set cmdCls = cmdfrm.cmdClass
        cmdCls.OnClick = EP
        
    Set cmdQuit = cmdfrm.cmdClose
        cmdQuit.OnClick = EP
End Sub

Private Sub cmdNor_Click()
Dim RptOpt As Integer

RptOpt = ReportOption()

    param = cmdfrm!Pass 'PassPercentage
    param = param & "," & RptOpt ' and report option
    
    If Nz(cmdfrm.Pass, 0) = 0 Then
        MsgBox "Enter pass-Mark Percentage?" & vbCr & "e.g.: default 60"
    Else
        DoCmd.OpenReport "StudentsPassFail_Normal", acViewPreview, , , , param
    End If
End Sub

Private Sub cmdCls_Click()
Dim RptOpt As Integer

RptOpt = ReportOption()
    param = cmdfrm!Pass 'PassPercentage
    param = param & "," & RptOpt ' and report option
    
    If Nz(cmdfrm.Pass, 0) = 0 Then
        MsgBox "Enter pass-Mark Percentage?" & vbCr & "e.g.: default 60"
    Else
        DoCmd.OpenReport "StudentsPassFail_Normal", acViewPreview, , , , param
    End If
End sub

'Event Subroutines
Private Sub cmdQuit_Click()
    If MsgBox("Close " & cmdfrm.Name & " Form?", vbYesNo + vbQuestion, "cmd_Click") = vbYes Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If
End Sub

In the global declaration area, the Main Form and Command Button instances are declared, along with two additional variables. The Opt variable stores the Report type option selected, which is returned from the ReportOption() function in a Standard Module. The param string variable is used to hold the OpenArgs input values passed to the Report.

The Report option selection menu is generated by the ReportOption() function in the Standard Module.

Within the Form object Set Property procedure, the Class_Init() subroutine is called. Inside Class_Init(), the Click Events for the Command Buttons are enabled, allowing the wrapper class to handle Report launching.

In the CmdNor_Click() subroutine, the ReportOption() function is called, and the returned value is stored in the RptOpt variable. The PassPercentage value is retrieved from the Form and stored in the param variable. The Report option selection is also appended to param, with both values separated by a comma.

The Report is then opened in Print Preview, with the combined parameter values passed through OpenArgs.

The CmdCls_Click() subroutine follows the same steps to open the StudentsPassFail_Class Report.

Finally, the CmdQuit_Click() event subroutine simply closes the Form.

ReportOption Function VBA Code.

Option Compare Database
Option Explicit

'Report Option Selection
Public Function ReportOption() As Integer
Dim msg As String

  msg = "1. Passed List" & vbCr & "2. Failed List"
  
  Opt = 0
  Do While Opt < 1 Or Opt > 2
    Opt = InputBox(msg, "Report Options", 1)
    If Opt = "" Then Opt = 0
  Loop
  
ReportOption = Opt
End Function

The Report StudentsPassFail_Normal Module VBA Code.

The following VBA code in the Report Module demonstrates how this functionality is implemented using the traditional coding approach. It is provided here for reference.

Option Compare Database
Option Explicit

Dim Opt As Variant

'---------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'---------------------------------------------------------
'Sreamlining Report Module Code in Standalone Class Module
'Author: a.p.r. pillai
'Date  : 22/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'---------------------------------------------------------
Private Sub Report_Load()
Dim x As Variant
x = Split(OpenArgs, ",")

Me!PassPercentage = Val(x(0))
Opt = Val(x(1))

End Sub

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
'Report Format Pass Calls this Subroutine
Dim Curval As Double
Dim pf As Double
Dim yn As Boolean

On Error GoTo Detail_Format_Err

pf = Me!PassPercentage
Curval = Me!Percentage 'Student's Marks percentage
yn = (Curval >= pf) 'check for pass/fail case

'Detail Section Detault Setting hidden
'During the Report Formatting phase the Items which meets
'the criteria only visible on the Report Detail Section when PrintPreviewed

Detail.Visible = False
If FormatCount = 1 Then 'The Report's Formatting Count=1 
       If yn Then ' yn=True - student Passed
          With Me
            .lblRemarks.Caption = "PASSED"
            .lblRemarks.ForeColor = RGB(0, 255, 0) 'Green Color
                If Opt = 1 Then 'Report Option Passed Students List
                    Detail.Visible = True 'Make the Detail Section Visible
                End If
          End With
        Else 'yn=False an Option=2 Cases
          With Me
            .lblRemarks.Caption = "FAILED"
            .lblRemarks.ForeColor = RGB(255, 0, 0) 'Red Color
                If Opt = 2 Then
                    Detail.Visible = True
                End If
          End With
        End If
End If


Detail_Format_Exit:
Exit Sub

Detail_Format_Err:
MsgBox Err.Description, , "Detail_Format()"
Resume Detail_Format_Exit
End Sub

Private Sub Report_Page()
    PageBorder Me.Name
End Sub

The StudentPassFail_Normal Report Module Segmentwise Code Review.

In the global declaration area, the Opt variable of type Variant is declared to hold the option selected for printing the Exam Result: the Passed or Failed list will be displayed in Print Preview.

The Report_Load Event Subroutine.

 
Option Compare Database
Option Explicit

Dim Opt As Variant

'---------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'---------------------------------------------------------
'Sreamlining Report Module Code in Standalone Class Module
'Author: a.p.r. pillai
'Date  : 22/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'---------------------------------------------------------
Private Sub Report_Load()
Dim x As Variant
x = Split(OpenArgs, ",")

Me!PassPercentage = Val(x(0))
Opt = Val(x(1))

End Sub

In the Form_Load() event procedure, the PassPercentage and the Report selection option—both passed as a single OpenArgs string separated by a comma—are split into a two-element array. The first element, x(0), containing the PassPercentage value, is assigned to the passpercentage TextBox on the Report. The second element, x(1), representing the Report type option, is stored in the Opt variable.

The PassPercentage value is first copied into the local variable pf. The next two lines retrieve the first student’s Obtained Marks Percentage from the Percentage TextBox and store it in the variable CurVal. The student’s score is then compared with the pass mark, and the result of this comparison is stored in the Boolean variable yn.

The following code segment validates whether the current student is in the Passed category within the Detail section of the Report.

Detail.Visible = False 'Hide the Detail Section
If FormatCount = 1 Then 'The first Format Pass on this Page.
       If yn Then
            lblRemarks.Caption = "PASSED"
            lblRemarks.ForeColor = RGB(0, 255, 0)
                If Opt = 1 Then 'Passed Students Listing
                    Detail.Visible = True
                End If
        Else
            lblRemarks.Caption = "FAILED"
            lblRemarks.ForeColor = RGB(255, 0, 0)
                If Opt = 2 Then
                    Detail.Visible = True
                End If
        End If
End If

The statement


Detail.Visible = False

initially hides the Detail Section of the Report. The next step ensures that the OnFormat event is executed for the Detail Section, for the first time, to lay out the student record. Note that the Report may go through multiple formatting passes per page in preparation for printing or Print Preview.

If the student is in the Passed category and the selected Report option is 1, then the Detail Section is made visible for that record, allowing it to appear in the Report.

Otherwise, if the student’s Obtained Marks Percentage is below the pass threshold and the selected option equals 2, those student records in the Detail Section are made visible. In both scenarios, the Boolean variable yn and the option selection must align correctly—TRUE & 1 for the Passed list, or FALSE & 2 for the Failed list—to ensure that only the relevant records appear on the Report.

Next, the Report_Page() subroutine calls the PageBorder() function from the Standard Module to draw the page border on the Report.

Private Sub Report_Page()
    PageBorder Me.Name
End Sub

The PageBorder() Function Code In the Standard Module.

Public Function PageBorder(ByVal strName As String)
Dim Rpt As Report, lngColor As Long
Dim sngTop As Single
Dim sngLeft As Single
Dim sngwidth As Single
Dim sngheight As Single

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Draw Report PageBorder
'Author: a.p.r. pillai
'Date  : 18/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

lngColor = RGB(0, 0, 255)
On Error GoTo DrawBox_Err

    Set Rpt = Reports(strName)
    ' Set scale to pixels.
    Rpt.ScaleMode = 3
    
    'outer Border
       sngTop = Rpt.ScaleTop        'Top Value After Margin
      sngLeft = Rpt.ScaleLeft       'Left Value After Margin
     sngwidth = Rpt.ScaleWidth - 7  ' Right Margin -7 pixels
    sngheight = Rpt.ScaleHeight - 7 'Bottom Margin -7 pixels
       
    ' Draw line as a box.
Rpt.Line (sngTop, sngLeft)-(sngwidth, sngheight), lngColor, B

  'Draw Box inside the outer Box
   sngTop = Rpt.ScaleTop + 5
  sngLeft = Rpt.ScaleLeft + 5
 sngwidth = Rpt.ScaleWidth - 13
sngheight = Rpt.ScaleHeight - 13

'Draw second Box within the Borders of the First Box
Rpt.Line (sngTop, sngLeft)-(sngwidth, sngheight), lngColor, B

DrawBox_Exit:
Exit Function

DrawBox_Err:
MsgBox Err.Description, , "DrawBox"
Resume DrawBox_Exit
End Function

The PageBorder() function accepts the open Report’s name as a parameter. It draws two concentric border lines inside the four sides of the Report’s margin area.

The function uses the LINE command with the X and Y coordinates of the top-left corner, offset from the left and top margins, and the bottom-right corner, positioned just before the right and bottom margins, to draw a diagonal line. The Color parameter, specified as an RGB value, determines the color of the line. The final parameter, B, instructs Access to draw a box using the diagonal coordinates, effectively creating the border around the page.

The Rpt.ScaleTop and Rpt.ScaleLeft properties determine the coordinates of the top-left corner of the page, adjusted to account for the Left and Top margin areas. Additional offset values are applied to ensure that when the box is drawn, it does not overlap the outer border or create an unintended second border inside it.

The Streamlining Procedure of the Report VBA Code.

Let us create a standalone Wrapper Class Module to transfer the Report Module code into it. The code for the ClsStudentsList Wrapper Class is shown below:

Option Compare Database
Option Explicit

Private WithEvents Rpt As Access.Report
Private WithEvents SecDetail As Access.[_SectionInReport]

Private RequiredMarks As Access.TextBox
Private Obtained As Access.TextBox
Private lblRem As Access.Label

Private Opt As Variant

'---------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'---------------------------------------------------------
'Sreamlining Report Module Code in Standalone Class Module
'Author: a.p.r. pillai
'Date  : 22/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'---------------------------------------------------------

Public Property Get mRpt() As Access.Report
   Set mRpt = Rpt
End Property

Public Property Set mRpt(RptNewVal As Access.Report)
  Set Rpt = RptNewVal

Call class_Init
End Property

Private Sub class_Init()
On Error GoTo Class_Init_Err:
Dim msg As String
Dim x As Variant

Const strEvent = "[Event Procedure]"
x = Split(Rpt.OpenArgs,",")

  With Rpt
    !PassPercentage = Val(x(0)) ' Pass Mark% save on Report
    Set RequiredMarks = .PassPercentage 'Assign this Control Reference to pct
    Opt = Val(x(1))
    Set Obtained = .Percentage     'Student's Obtained Percentage
    Set lblRem = .lblRemarks 'Passed/Failed Display Label
    Set SecDetail = .Section(acDetail) 'Detail Section Reference
    
     SecDetail.OnFormat = strEvent 'Enable Detail Section Format Event
     .OnPage = strEvent 'Enable Report_Page Event
  End With
  
Class_Init_Exit:
Exit Sub

Class_Init_Err:
MsgBox Err & ": " & Err.Description, vbCritical + vbOK, "Class_Init()"

Resume Class_Init_Exit
End Sub

Private Sub secDetail_Format(Cancel As Integer, FormatCount As Integer)
'Report Format Pass Calls this Subroutine
Dim Curval As Double
Dim pf As Double    'pass/fail
Dim yn As Boolean

On Error GoTo secDetail_Format_Err

Curval = Nz(Obtained.Value, 0)
pf = Nz(RequiredMarks.Value, 0)
yn = (Curval >= pf)

'Start Laying the Detail Section items from Format Count 1 onwards.
'All the Records are placed on the Detail Section, but the
'Lines which meets the Criteria only made visible on the Report.

SecDetail.Visible = False 'Hide the Detail Section
If FormatCount = 1 Then 'The first Format Pass on this Page.
       If yn Then
            lblRem.Caption = "PASSED"
            lblRem.ForeColor = RGB(0, 255, 0)
                If Opt = 1 Then 'Passed Students Listing
                    SecDetail.Visible = True
                End If
        Else
            lblRem.Caption = "FAILED"
            lblRem.ForeColor = RGB(255, 0, 0)
                If Opt = 2 Then
                    SecDetail.Visible = True
                End If
        End If
End If

secDetail_Format_Exit:
Exit Sub

secDetail_Format_Err:
MsgBox Err & ": " & Err.Description, , "secDetail()"
Resume secDetail_Format_Exit
End Sub

Private Sub Rpt_Page()
    PageBorder Rpt.Name
End Sub

In the global declaration area, a Report object named Rpt is declared and qualified with the WithEvents keyword, allowing the class to capture Report-level events (such as Report_Page()) and execute their corresponding event subroutines. Additionally, a Report Section object, SecDetail, is also declared with WithEvents to capture Detail Section Format events of the Report.

Two TextBox controls and a Label control are declared. The first TextBox, RequiredMarks, stores the pass mark percentage entered on the Form used to launch the Report and passed via OpenArgs. The second TextBox, Obtained, reads the student’s obtained marks percentage directly from the Report.

The lblRem Label control corresponds to the Remarks column on the Report and will display “PASSED” or “FAILED” based on the Report type option selected. The Opt variable of type Variant stores the Report type option returned from the ReportOption() function.

Next, the Report object property Get, Set procedures assign the Report reference to the Rpt object in the ClsStudentsList Wrapper Class. Within the Set m_Rpt() property procedure, the Class_Init() subroutine is called to initialize the class. The relevant Class_Init() code segment is shown below:

Private Sub class_Init()
On Error GoTo Class_Init_Err:
Dim msg As String
Dim x As Variant

Const strEvent = "[Event Procedure]"
x = Split(Rpt.OpenArgs,",")

  With Rpt
    !PassPercentage = Val(x(0)) ' Pass Mark% save on Report
    Set RequiredMarks = .PassPercentage 'Assign this Control Reference to pct
    Opt = Val(x(1))
    Set Obtained = .Percentage     'Student's Obtained Percentage
    Set lblRem = .lblRemarks 'Passed/Failed Display Label
    Set SecDetail = .Section(acDetail) 'Detail Section Reference
    
     SecDetail.OnFormat = strEvent 'Enable Detail Section Format Event
     .OnPage = strEvent 'Enable Report_Page Event
  End With
  
Class_Init_Exit:
Exit Sub

Class_Init_Err:
MsgBox Err & ": " & Err.Description, vbCritical + vbOK, "Class_Init()"

Resume Class_Init_Exit
End Sub

At the beginning of the Class_Init() subroutine, a local variable msg and a constant variable strEvent, assigned the text "[Event Procedure]", are declared.

The next segment of VBA code initializes the previously declared object variables by assigning them references to the corresponding controls on the Report.

x = Split(Rpt.OpenArgs,",")

  With Rpt
    !PassPercentage = Val(x(0)) ' Pass Mark% save on Report
    Set RequiredMarks = .PassPercentage 'Assign this Control Reference to pct
    Opt = Val(x(1))
    Set Obtained = .Percentage     'Student's Obtained Percentage
    Set lblRem = .lblRemarks 'Passed/Failed Display Label
    Set SecDetail = .Section(acDetail) 'Detail Section Reference
    
     SecDetail.OnFormat = strEvent 'Enable Detail Section Format Event
     .OnPage = strEvent 'Enable Report_Page Event
  End With

The statement


x = Split(Rpt.OpenArgs, ",")

splits the OpenArgs string into two parts. The first element, x(0), containing the Pass Percentage Marks, is assigned to the corresponding TextBox on the Report. The second element, x(1), representing the Report category option, is stored in the Opt variable.

The student’s Obtained Marks Percentage is assigned to the Obtained TextBox instance in the class module. The lblRem Label object is assigned the reference of the lblRemarks Label control under the Remarks column on the Report. Finally, the SecDetail object is assigned the reference of the Report’s Detail Section.

Note: What does “reference” mean in the context of a Form, Control, or Object?

When a Form or Control is loaded into memory, it occupies a specific area of the computer’s memory with an addressable reference (or memory pointer). Although we don’t know the exact memory address, it is directly associated with the object’s name, such as Text0 or Quantity.

When this reference is assigned to an instance of the same object type—for example:


Set Txt = myForm.Quantity

—we can manipulate the physical object indirectly through the instance. For example, setting


Txt.Value = 20

stores the value 20 in the Quantity TextBox on the Form.

Similarly, when we pass a Form or TextBox to a function, actually we are passing the reference to that object, not a copy of the object itself.

This concept of working with object references is the foundation of streamlining Form and Report module code using standalone class modules.

Here’s a simple conceptual diagram (by ChatGPT) to illustrate how object references work in VBA:


+----------------------+          +----------------------+
|  Form: myForm        |          |  Memory (Objects)    |
|----------------------|          |----------------------|
| TextBox: Quantity    |  --->    | [Memory Address 101] |  <- Physical TextBox in memory
| TextBox: Name        |          | [Memory Address 102] |
| CommandButton: OK    |          | [Memory Address 103] |
+----------------------+          +----------------------+
         |
         | Set Txt = myForm.Quantity
         v
+----------------------+
|  Txt (Variable)      |
|----------------------|
| Reference -> 101     |  <- Points to the Quantity TextBox in memory
+----------------------+

Usage Example:
Txt.Value = 20  ' Updates the actual Quantity TextBox on the Form

Explanation:

Each control on the Form occupies memory when the Form is loaded.
Assigning a control to a variable with Set does not create a new control; it creates a reference pointing to the same memory location.
Any changes made via the reference (Txt.Value = 20) directly affect the original control.
Functions that accept a Form or Control as a parameter actually receive the reference, allowing the function to work directly with the original object.

Diagram provided by ChatGPT

@@@Next, the Report Detail Section Format and Report_Page() Events are enabled. Once these are active, the Report Type Option Menu is displayed, allowing the user to select the required report.

After the Report Type Option is chosen, the report formatting process begins, with special attention to the requirements of the Detail Section. We have already covered the code written in the Detail Section’s Format Event Procedure and explained its functionality earlier.

At the Page level, the Report_Page Event Procedure calls the PageBorder() Function in the Standard Module to draw the border around each Report Page.

Finally, to execute the code in the ClsStudentsList Class Module, we must explicitly load this module into memory through the Report_Load() Event Procedure. A Class Module cannot load itself into memory. The streamlined VBA code for the Report Module is given below.

Option Compare Database
Option Explicit

Private Marks As New ClsStudentsList

Private Sub Report_Load()
  Set Marks.mRpt = Me
End Sub

The above four lines of code load the Standalone Class Module into memory and start the entire process to run from within the Class Module.

I hope you enjoy working with VBA in Standalone Class Modules and recognize their potential to streamline your development process. By separating Report Design from VBA coding, you gain the flexibility to easily reuse and transport code across projects, saving valuable time while ensuring cleaner, more maintainable solutions.

Demo Database Download Link. Change Database.

StudentsMarkList.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Report Module Code in Class Module.

2023-09-12T21:30:00.023+05:30

Introduction.

Report Module VBA Code in Standalone Class Module.

In the earlier episodes of this series, Streamlining Form Module Code in the Standalone Class Module, we explored how to handle Event Subroutines for frequently used Access controls within a standalone Class Module. This approach allows for managing event handling in Standalone Class Module(s), without interfering with the design task of the Form, resulting in cleaner, more maintainable code.

If you’re new to handling Form/Report Module Event Procedures in standalone Class Modules, I suggest starting with the earlier episodes in this series. These articles provide the necessary background and step-by-step explanations to help you understand and apply this approach effectively. Links to all previous articles in the series are provided at the end of this page.

The Report Section Print Event Subroutines.

This is a repeat of the two Blog Posts published earlier on Highlighting Report Lines conditionally, as part of the new concept of Streamlining Form/Report Module Code in the Standalone Class Module. This demonstrates how to transfer the existing Event Subroutine Codes from the Report Module to the Standalone Class Module. Generally speaking, this is double work, and nobody would like to go into the Code again, which was written for a particular task after incorporating several refinements and final touches.

But, I think if you would like to do some trial runs and try to convert a few existing Form/Report Module Codes to the new way of coding, you will know how much extra work you put into the traditional method, and it will give you more insights into the new way of coding, in comparison with the traditional way.

Organize the Existing Form Module Code for the Standalone Class Module.

Before moving forward with this approach, it is essential to first organize the existing code in the Form Module Code by grouping it by the Control types.
Create a copy of the Form you want to experiment with and give it a new name. Then, plan to transfer all of its TextBox Event Subroutine code into a dedicated TextBox Wrapper Class as the first step.
In preparation, move the TextBox Event Subroutines next to each other on the Form Module itself first. If a single TextBox has more than one Event Subroutine, then arrange them next to each other too.
Create a TextBox Wrapper Class.
Create the Intermediate Class Module and enable the Events of the TextBoxes in the Class_Init() Subroutine.
Copy and paste the TextBox Event Subroutines from the Form Module to the Wrapper TextBox Class and modify the Event Subroutine Names with the correct TextBox Object Instance name as Subroutine name Prefix. Use the Select Case . . . End Select structure inside each category of Event to position the Code that belongs to a particular TextBox on the Form.
Delete the Copied Subroutines from the Form Module.
At the Form Module global declaration area, define the Intermediate Class Object Instance and in the Form_Load() Event Procedure, pass the Me Form object to the Set Frm() Property Procedure.
Save the Form after changes.
Before we try this new Form with the Wrapper Class-based Event Subroutines in place, rename the original Form with a new name with a suffix of X or Y.
Rename the new Form to the Original name.
Open the Form as you do from your Main Menu, or whatever method is built into your Project, and ensure that all the Subroutines of all the TextBoxes on the Form function as before. If any errors, track, find, and correct them, and ensure everything works normally as before.
Repeat this process for all other controls on the Form.

The Traditional Way of Coding.

The traditional method of Coding is the best way for beginners to learn VBA, and that is how we all started learning VBA. My first PC was the Spectravideo Model SV-328 with built-in Microsoft Extended Basic, and I started learning the BASIC Language from there, writing programs and saving them to the audio Cassette Tapes, the cheapest mode of storage at that time.

It is interesting now to look at the Bootup Screen Image of this Computer, given below (courtesy of Wikipedia.org):

Then came the GW-Basic, QuickBASIC, Visual Basic, and VBA.

There is an interesting Computer Buying Guide that I have from 1986, published by the Consumer Guide Magazine, for Computers with a Price Range of $299 (Commodore 128) to $4550 (Kaypro 286i, with 512K RAM, Speed 6 MHz, 80286 microprocessor, compatible with IBM PC AT).

The configuration of the machines, their speed, and the Prices of the machines in those days are interesting to read and compare with the present-day machines.

The following two links to earlier Blog Posts on Report Module Coding highlight some Report lines on certain conditions during the Printing cycle of the Report.

1. Highlighting Reports. - August 16, 2007

2. WithEvents and Report Line Highlighting - June 21, 2019

Let us see how we can run the Report Print Event Subroutines Code in the Standalone Class Module.

The Students' Examination Result Report Image.

Right-click to open Large Image in New Tab/Window.

Note: If you attempt to run the Report (StudentHighlight_Normal) directly by double-clicking on the Report, the Report may open in the ReportPreview Mode and not in PrintPreview Mode. In that case, you will not find the display as shown above. Right-click on the Report, and select the PrintPreview option from the displayed Menu to view the Report correctly.

The Students’ Examination Report displays the final results. The minimum pass requirement is set at 60% (360 marks out of 600). For students who fall short of this threshold, their percentage scores are visually highlighted with a red ellipse around the marks. Additionally, a legend label is included in the report footer, drawn within a circle to indicate the meaning of the highlight.

To experiment with different pass mark percentages, a Form is provided with a TextBox where you can enter the desired pass percentage before launching the Exam Result Report in Print Preview mode. The specified percentage is passed to the Report through the OpenArgs parameter when the Report is opened. The sample Form image is shown below for reference.

Right-click to open Large Image in New Tab/Window.

The VBA Code run earlier in the Report Class Module is listed below for reference. This Code will be transferred to the Standalone Class Module to run the procedure in the new Coding method.

Option Compare Database
Option Explicit

Private Curval As Double
Private MinTarget As Double

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
Dim intPrintCircle As Boolean

On Error GoTo secRpt_Print_Err

MinTarget = Me!PassPercentage
Curval = Me!Percentage

If (MinTarget > 0) And (Curval < MinTarget) Then
  intPrintCircle = True
Else
  intPrintCircle = False
End If

DrawCircle intPrintCircle, Me.Percentage

secRpt_Print_Exit:
Exit Sub

secRpt_Print_Err:
MsgBox Err.Description, , "secRpt_Print()"
Resume secRpt_Print_Exit
End Sub

Private Sub ReportFooter_Print(Cancel As Integer, PrintCount As Integer)
Dim yn As Boolean, lbl As Control

On Error GoTo secFutr_Print_Err

yn = True 'set the flag false to draw oval shape
Set lbl = Me.Legend 'pass label control in Page Footer

DrawCircle yn, lbl 'draw circle in legend label

secFutr_Print_Exit:
Exit Sub

secFutr_Print_Err:
MsgBox Err.Description, , "secFutr_Print"
Resume secFutr_Print_Exit

End Sub

Private Sub DrawCircle(ByVal bool As Boolean, ovlCtl As Control)
Dim ctl As Control
Dim bolPrintCircle As Boolean
Dim sngAspect As Single
Dim intShapeHeight As Integer
Dim intShapeWidth As Integer
Dim sngXCoord As Single
Dim sngYCoord As Single

On Error GoTo DrawCircle_Err

If bool Then 'if pass no highlighting, change logic for pass cases
    bolPrintCircle = True
Else 'highlight failed cases
    bolPrintCircle = False
End If

Set ctl = ovlCtl
        
    If Not IsNull(ctl) Then
        If bolPrintCircle Then
           ' change this value to adjust the oval shape of the circle.
            sngAspect = 0.25
   
            ' Determine coordinates of ctl and to draw ellipse.
            ' Determine height and width of ellipse.
            intShapeHeight = ctl.Height
            intShapeWidth = ctl.Width
    
            'calculate circle vertical Y coordinate
            sngYCoord = ctl.Top + (intShapeHeight \ 2)

            'calculate horizontal X coordinate of circile
            sngXCoord = ctl.Left + (intShapeWidth \ 2)
            
            'draw an ellipse around the Total TextBox
            Report.Circle (sngXCoord, sngYCoord), intShapeWidth \ 2, RGB(255, 0, 0), , , sngAspect
            bolPrintCircle = False
        End If
    End If

DrawCircle_Exit:
Exit Sub

DrawCircle_Err:
MsgBox Err.Description, , "DrawCircle()"
Resume DrawCircle_Exit
End Sub

Review of the VBA Code in the Report Class Module.

The Report uses two Event Subroutines: Detail_Print() and ReportFooter_Print(). In both cases, the DrawCircle() Subroutine is invoked to highlight specific areas. Within the Detail_Print() event, it draws an ellipse around the percentage marks in the TextBox when the student’s score falls below the pass criteria. The threshold value is supplied through the OpenArgs parameter passed from the Form’s TextBox at the time the Report is opened. Similarly, in the ReportFooter_Print() event, the same Subroutine is used to draw the legend circle around the Label in the Report Footer.

The Print Event Subroutines are written directly in the Report Module StudentHighLight_Normal, as is normally done in Access. This demonstration Report can be executed directly from the sample database provided at the end of this page. Simply open the Form shown above and click the Command Button labeled “Normal Report” to view the result.

The Changed VBA Code in the Standalone Class Module.

The same Event Subroutines and the DrawCircle() Subroutine Codes are removed from the Report Class Module and placed in the Standalone Wrapper Class Module as given below:

Option Compare Database
Option Explicit

Private WithEvents Rpt As Access.Report
Private WithEvents secRpt As Access.[_SectionInReport]
Private WithEvents secFutr As Access.[_SectionInReport]

Private pct As Access.TextBox  'Percentage
Private lgnd As Access.Label
Private Pass As Integer 'OpenArgs Value
'------------------------------------------------------
'Streamlining Report Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Streamlining Report Module Code
'Author: a.p.r. pillai
'Date  : 12/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
Public Property Get mRpt() As Access.Report
   Set mRpt = Rpt
End Property

Public Property Set mRpt(RptNewVal As Access.Report)
  Set Rpt = RptNewVal
  
  Call Class_Init
End Property

Private Sub Class_Init()
On Error GoTo mRpt_Err
Const strEvent = "[Event Procedure]"

'Pass Percentage value
  Pass = Nz(Rpt.OpenArgs, 0) 'OpenArgument
  Rpt.PassPercentage.Value = Pass
  
  With Rpt
     Set secRpt = .Section(acDetail)
     Set secFutr = .Section(acFooter)
     
     secRpt.OnPrint = strEvent  'Enable Event
     secFutr.OnPrint = strEvent '    "
  End With
  
  Set pct = Rpt!Percentage
  Set lgnd = Rpt.Legend
 
mRpt_Exit:
Exit Sub

mRpt_Err:
MsgBox Err.Description, , "mRpt()"
Resume mRpt_Exit

End Sub

'Draw ellipse around controls that meet specified criteria.
Private Sub secRpt_Print(Cancel As Integer, PrintCount As Integer)

Dim obtPct As Double
Dim yn As Boolean

On Error GoTo secRpt_Print_Err

    obtPct = pct.Value         'read Pass Percentage TextBox value
    yn = (obtPct < Pass)      'Passed or Not (TRUE/FALSE)

'call the DrawCircle Subroutine with Fail flag
'and the Control as parameters
    Call DrawCircle(yn, pct)

secRpt_Print_Exit:
Exit Sub

secRpt_Print_Err:
MsgBox Err.Description, , "secRpt_Print"
Resume secRpt_Print_Exit

End Sub

'Draw oval shape around Label in Report_Footer Section
Private Sub secFutr_Print(Cancel As Integer, PrintCount As Integer)
Dim yn As Boolean, lbl As Control

On Error GoTo secFutr_Print_Err

Set lbl = lgnd 'Fail label control in Page Footer
yn = True 'set the flag True to draw oval shape

Call DrawCircle(yn, lbl) 'draw circle in legend label

secFutr_Print_Exit:
Exit Sub

secFutr_Print_Err:
MsgBox Err.Description, , "secFutr_Print"
Resume secFutr_Print_Exit

End Sub

Private Sub DrawCircle(ByVal bool As Boolean, ovlCtl As Control)
Dim ctl As Control
Dim bolPrintCircle As Boolean
Dim sngAspect As Single
Dim intShapeHeight As Integer
Dim intShapeWidth As Integer
Dim sngXCoord As Single
Dim sngYCoord As Single

On Error GoTo DrawCircle_Err

If bool Then 'Highlight Failed Cases
    bolPrintCircle = True
Else
    bolPrintCircle = False
End If

Set ctl = ovlCtl
    If Not IsNull(ctl) Then
        If bolPrintCircle Then
        ' change this value to adjust the oval shape of the circle.
            sngAspect = 0.25
   
        ' Determine coordinates of ctl and to draw ellipse.
        ' Get height and width of Control.
            intShapeHeight = ctl.Height
            intShapeWidth = ctl.Width
    
        'calculate circle vertical Y coordinate
            sngYCoord = ctl.Top + (intShapeHeight \ 2)

        'calculate horizontal X coordinate of circile
            sngXCoord = ctl.Left + (intShapeWidth \ 2)
            
        'Draw an ellipse within the Percentage TextBox Boundaries
        'in Red Color
            Rpt.Circle (sngXCoord, sngYCoord), intShapeWidth \ 2, RGB(255, 0, 0), , , sngAspect
            bolPrintCircle = False
        End If
    End If

DrawCircle_Exit:
Exit Sub

DrawCircle_Err:
MsgBox Err.Description, , "DrawCircle()"
Resume DrawCircle_Exit

End Sub

Review of the Report Wrapper Class VBA Code.

To run the Standalone Class Module Code with the Report, we first need to obtain a reference to the open Report and assign it to the Report object instance Rpt within our Standalone Class Module. Once this is set, the Event procedures can be captured and executed outside the Report’s own module. Let us now walk through the code from the beginning up to the Class_Init() segment.

Option Compare Database
Option Explicit

Private WithEvents Rpt As Access.Report
Private WithEvents secRpt As Access.[_SectionInReport]
Private WithEvents secFutr As Access.[_SectionInReport]

Private pct As Access.TextBox  'Percentage
Private lgnd As Access.Label
Private Pass As Integer 'OpenArgs Value
'------------------------------------------------------
'Streamlining Report Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Streamlining Report Module Code
'Author: a.p.r. pillai
'Date  : 12/09/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
Public Property Get mRpt() As Access.Report
   Set mRpt = Rpt
End Property

Public Property Set mRpt(RptNewVal As Access.Report)
  Set Rpt = RptNewVal
  
  Call Class_Init
End Property

Private Sub Class_Init()
On Error GoTo mRpt_Err
Const strEvent = "[Event Procedure]"

'Pass Percentage value
  Pass = Nz(Rpt.OpenArgs, 0) 'OpenArgument
  Rpt.PassPercentage.Value = Pass
  
  With Rpt
     Set secRpt = .Section(acDetail)
     Set secFutr = .Section(acFooter)
     
     secRpt.OnPrint = strEvent  'Enable Event
     secFutr.OnPrint = strEvent '    "
  End With
  
  Set pct = Rpt.Percentage
  Set lgnd = Rpt.Legend
 
mRpt_Exit:
Exit Sub

mRpt_Err:
MsgBox Err.Description, , "mRpt()"
Resume mRpt_Exit

End Sub

The first three lines, immediately following Option Explicit, declare a Report object instance named Rpt, qualified with the WithEvents keyword to capture the Report’s events. In addition, two Report Section objects (Access.[_SectionInReport]) are declared, followed by two Report Control objects and an Integer variable.

Next, the Set and Get Property Procedures for the Report object are defined. Once the Report object is assigned to the Rpt instance variable, the Set mRpt() Property Procedure calls the Class_Init() Subroutine to initialize the class.

The strEvent A constant variable is assigned the string value "[Event Procedure]". The statement


Pass = Nz(Rpt.OpenArgs, 0)

reads the Pass Mark percentage passed through the DoCmd.OpenReport call from the Form and stores it in the Integer variable Pass. The next line assigns this value to the PassPercentage TextBox on the Report.

Next, the Report Detail Section and Footer Section References are assigned to the secRpt and secFutr Section Objects, respectively. The next two lines of Code enable printing events.

The statement Set pct = 'Rpt.Percentage' assigns the Obtained Marks Percentage TextBox reference, and the 'lgnd' Label Object is assigned with the Reference of the Legend label control at the Report Footer.

These initialisation steps run in the standalone Class Module when the Report is opened from the cmdClass Click Event Subroutine.

Private Sub cmdClass_Click()
    If Nz(Me.Pass, 0) = 0 Then
        MsgBox "Enter pass-Mark Percentage?" & vbCr & "e.g.: 60"
    Else
        'Me.Pass - Pass Mark Percentage value passed as OpenArgs
        DoCmd.OpenReport "StudentsHighlight_Class", acViewPreview, , , , Me.Pass
    End If
End Sub

Report Class Module VBA Code.

In the Report Class Module, declare an Instance of the Standalone Class Module Object ClsStudentHighlight with the name Marks in the global area. The New keyword in Private Marks As New ClsStudentHighlight statement creates an instance of the Standalone Class Module in memory.

In the Report_Load() Event Subroutine, the current Report Object Me is passed to the Set mRpt() Property Procedure in the ClsStudentHighlight Class Module Object.

Option Compare Database
Option Explicit

Private Marks As New ClsStudentHighlight

Private Sub Report_Load()
  Set Marks.mRpt = Me
End Sub

The Report Detail_Print() Event.

When the Report is open, the ClsStudentHighlight standalone Class Module Instance is also open in memory by the Report Module global declaration statement. The current Report Reference is passed to the Set mRpt() Property Procedure, and the standalone Class Module Code starts executing.

'Draw ellipse around controls that meet specified criteria.
Private Sub secRpt_Print(Cancel As Integer, PrintCount As Integer)

Dim obtPct As Double
Dim yn As Boolean

On Error GoTo secRpt_Print_Err

    obtPct = pct.Value         'read Pass Percentage TextBox value
    yn = (obtPct < Pass)      'Passed or Not (TRUE/FALSE)

'call the DrawCircle Subroutine with Fail flag
'and the Control as parameters
    Call DrawCircle(yn, pct)

secRpt_Print_Exit:
Exit Sub

secRpt_Print_Err:
MsgBox Err.Description, , "secRpt_Print"
Resume secRpt_Print_Exit

End Sub

When the Report is open, two major events occur: the Report Format Event and the Report Print Event. The Report Format Event organizes the data line by line and determines how many lines of data can fit on a single page, taking into account the paper size, the design height of the Detail section, and the page orientation.

In contrast, the highlighting of Exam Failed cases is performed exclusively during the Report Print Event, ensuring that the visual emphasis is applied at the time of printing or print-previewing the Report. There are two Variables declared for reading the Obtained Percentage of Marks from the Percentage TextBox on the Report into the Variable obtPct. If the obtained mark is less than the Pass Mark percentage (received in the OpenArgs), then the Boolean Variable yn value is set as TRUE.

Next, the DrawCircle() Subroutine is called, with the yn Test Result and pct Percentage TextBox object as parameters, to draw a red oval shape around the Percentage TextBox on the Report, indicating that the student is not successful in their examination.

The DrawCircle() Subroutine Code.

Private Sub DrawCircle(ByVal bool As Boolean, ovlCtl As Control)
Dim ctl As Control
Dim bolPrintCircle As Boolean
Dim sngAspect As Single
Dim intShapeHeight As Integer
Dim intShapeWidth As Integer
Dim sngXCoord As Single
Dim sngYCoord As Single

On Error GoTo DrawCircle_Err

If bool Then 'Highlight Failed Cases
    bolPrintCircle = True
Else
    bolPrintCircle = False
End If

Set ctl = ovlCtl
    If Not IsNull(ctl) Then
        If bolPrintCircle Then
        ' Increase/Decrease this value to adjust the oval shape of the circle.
            sngAspect = 0.25
   
        ' Calculate the coordinates of the ctl to draw the ellipse.
        ' Get height and width of Control.
            intShapeHeight = ctl.Height
            intShapeWidth = ctl.Width
    
        'calculate circle vertical Y coordinate
            sngYCoord = ctl.Top + (intShapeHeight \ 2)

        'calculate horizontal X coordinate of circle
            sngXCoord = ctl.Left + (intShapeWidth \ 2)
            
        'Draw an ellipse within the Percentage TextBox Boundaries
        'in Red Color
            Rpt.Circle (sngXCoord, sngYCoord), intShapeWidth \ 2, RGB(255, 0, 0), , , sngAspect
            bolPrintCircle = False
        End If
    End If

DrawCircle_Exit:
Exit Sub

DrawCircle_Err:
MsgBox Err.Description, , "DrawCircle()"
Resume DrawCircle_Exit

End Sub

The DrawCircle() Subroutine VBA Code Review.

At the beginning of the routine, the essential variables are declared. If the first parameter bool is TRUE, the local variable bolPrintCircle is set TRUE to indicate that an ellipse should be drawn.

The sngAspect variable is initialized with the value 0.25, which creates an oval shape around the TextBox. This value can be adjusted—either increased or decreased—to ensure that the ellipse fits neatly within the TextBox’s dimensions without overflowing. The actual Width and Height of the TextBox are captured and stored in the variables intShapeWidth , and intShapeHeight respectively, to guide the drawing of the ellipse.

The next two statements calculate the center point (X and Y coordinates) of the ellipse (oval shape).

The Rpt.Circle() statement Draws the Circle in red using the value intShapeWidth\2 as the Radius Value of the Circle.

The ReportFooter_Print() Event Subroutine.

'Draw oval shape around Label in Report_Footer Section
Private Sub secFutr_Print(Cancel As Integer, PrintCount As Integer)
Dim yn As Boolean, lbl As Control

On Error GoTo secFutr_Print_Err

Set lbl = lgnd 'Fail label control in Page Footer
yn = True 'set the flag True to draw oval shape

Call DrawCircle(yn, lbl) 'draw circle in legend label

secFutr_Print_Exit:
Exit Sub

secFutr_Print_Err:
MsgBox Err.Description, , "secFutr_Print"
Resume secFutr_Print_Exit

End Sub

The ReportFooter_Print() Subroutine Calls the DrawCircle() Subroutine to draw the ellipse within the Legend Label Control.

Demo Database Download Link.

MarksHighlight.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form Module Code - Part Eleven

2023-08-31T17:45:00.132+05:30

Introduction.

In this Episode of Streamlining Form Module VBA Code, we will create Wrapper Classes for ComboBox and OptionGroup Controls. Having gone through the previous Episodes, you are now acquainted with the process of creating Wrapper Class Modules for other controls, such as TextBox, ListBox, CommandButton, and TabControl. You have also learned to write Event Subroutines within these modules instead of placing them in the Form Module.

ComboBox and OptionGroup Control.

In this session, we will focus on the usage of ComboBox and OptionGroup controls, as illustrated in the form image shown below.

Right-click to open Large Image in New Tab/Window.

The Order Detail data displayed in the ListBox is filtered through the query OrderDetailQ1, which is based on the Employee ID selected in the ComboBox control named cboEmp, located above the ListBox. The SQL statement for this query is shown below:

OrderDetailQ1 SQL.

SELECT Orders.EmployeeID, Employees.LastName, Orders.OrderID, Val(Format([OrderDate],"yyyy")) AS [Year], Orders.Freight
FROM Employees INNER JOIN Orders ON Employees.EmployeeID = Orders.EmployeeID
WHERE (((Orders.EmployeeID)=[Forms]![Frm_OptionGroup]![cboEmp]));

The Freight values from OrderDetailQ1 are summarized by year in the query OrderSummaryQ1. This query provides the year-wise Freight totals, which serve as the source data for the Graph Chart displayed on the Form. The SQL statement for OrderSummaryQ1 is shown below:

OrderSummaryQ1 SQL.

SELECT [OrderDetailQ1].EmployeeID, [OrderDetailQ1].LastName, [OrderDetailQ1].Year, Sum([OrderDetailQ1].freight) AS Freight
FROM OrderDetailQ1
GROUP BY [OrderDetailQ1].EmployeeID, [OrderDetailQ1].LastName, [OrderDetailQ1].Year;

Freight Summary Data for the Chart.

Employee	Last Name	Year	Freight
Davolio, Nancy	Davolio	        1996	₹ 1,871.09
Davolio, Nancy	Davolio	        1997	₹ 4,584.47
Davolio, Nancy	Davolio	        1998	₹ 2,381.13

How are ComboBox, ListBox, and the Chart linked together?

When an Employee is selected in the ComboBox, the AfterUpdate event is triggered, and the statement cbofrm.List0.Requery refreshes the contents of the ListBox.

A hidden unbound TextBox on the Form is used to copy the Employee ID value from the cboEmp ComboBox. This TextBox serves as the Link Master Field for the Graph Chart, ensuring that the year-wise Freight summary updates automatically.

As a result, whenever the Employee selection changes (note that the ComboBox displays only the Employee Name, with the first column EmployeeID hidden by setting its column width to zero), both the OrderDetail ListBox and the year-wise Freight values in the Graph Chart are refreshed instantly.

The OptionGroup Control.

The OptionGroup control can contain a set of Radio Buttons, Check Boxes, or Toggle Buttons, all placed within a common Frame. In this example, we are using Radio Buttons inside an OptionGroup frame named Frame7. The Frame7 control holds three Radio Buttons, each with its own label, and is positioned below the ListBox and Graph objects on the Form.

There are three options to display the Employee's Freight Sales Values in three different categories.

- The highest Freight Sales Value of the Employee.
- The Lowest Freight Sales Value.
- The Total Fright Sales Value.

An Unbound TextBox, placed to the left of the OptionGroup control, displays the value of the selected Radio Button. Next to it, a Label control shows the selected option description. The label text is presented in an animated style, smoothly moving from right to left to highlight the current selection.

The Command Button Click will close the Form.

We already created wrapper classes for the ComboBox and ListBox in the earlier episodes. The OptionGroup Control is new in this Series of Tutorials and needs a Wrapper Class. When we place an OptionGroup Control on the Form, the default name used by Microsoft Access is something like Frame7. We will create a Wrapper Class named OptFrame for the OptionGroup Control.

The OptFrame Wrapper Class VBA Code.

Option Compare Database
Option Explicit

Private WithEvents Opt As Access.OptionGroup
Private frm As Access.Form

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'OptionGroup Wrapper Class
'Author: a.p.r. pillai
'Date  : 31/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get opt_Frm() As Form
    Set opt_Frm = frm
End Property

Public Property Set opt_Frm(ByRef ofrm As Form)
    Set frm = ofrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get o_opt() As OptionGroup
    Set o_opt = Opt
End Property

Public Property Set o_opt(ByRef mopt As OptionGroup)
    Set Opt = mopt
End Property

'Event Subroutines Code
Private Sub opt_Click()
Dim Rslt As Variant
Dim Cap(1 To 3) As String
Static strText As String

Cap(1) = "Highest Freight Value:"
Cap(2) = " Lowest Freight Value:"
Cap(3) = "  Total Freight Value:"

Select Case Opt.Name
    Case "Frame7"
        Select Case Opt.Value
            Case 1
            'Repeated Clicks on the same option is ignored.
            If strText = Cap(1) Then Exit Sub
                Rslt = DMax("Freight", "OrderDetailQ1")
            Case 2
                If strText = Cap(2) Then Exit Sub
                Rslt = DMin("Freight", "OrderDetailQ1")
                
            Case 3
                If strText = Cap(3) Then Exit Sub
                Rslt = DSum("Freight", "OrderDetailQ1")
        End Select
End Select
       frm!Result = Rslt
       strText = Cap(Opt)
       
       Call Animate(strText) 'Label Animation
End Sub

Private Sub Animate(ByVal txt As String)
'Label Animation
Dim L As Double
Dim n As String
Dim T As Double
Dim j As Integer

L = Len(txt)
txt = Space(L) & txt

For j = 1 To Len(txt) - L
 n = Left(txt, 1)
 txt = Right(txt, Len(txt) - 1)
 txt = txt & n
 frm.lblResult.Caption = Left(txt, L)

    Delay 0.02 'delay 20 milliseconds

Next
End Sub

In the OptFrame Wrapper Class Module, the OptionGroup control object (Opt) is declared with the WithEvents keyword in the global section of the Class Module. Alongside it, a Form object property named frm is also declared. Corresponding Property Procedures are then defined to manage these global properties.

The Opt_Click() Event Subroutine.

Private Sub opt_Click()
Dim Rslt As Variant
Dim Cap(1 To 3) As String
Static strText As String

Cap(1) = "Highest Freight Value:"
Cap(2) = " Lowest Freight Value:"
Cap(3) = "  Total Freight Value:"

Select Case Opt.Name
    Case "Frame7"
        Select Case Opt.Value
            Case 1
                If strText = Cap(1) Then Exit Sub
                Rslt = DMax("Freight", "OrderDetailQ1")
            Case 2
                If strText = Cap(2) Then Exit Sub
                Rslt = DMin("Freight", "OrderDetailQ1")
                
            Case 3
                If strText = Cap(3) Then Exit Sub
                Rslt = DSum("Freight", "OrderDetailQ1")
        End Select
End Select
       frm!Result = Rslt
       strText = Cap(Opt)
       
       Call Animate(strText) 'Label Animation
End Sub

The OptionGroup control on the Form provides three options to extract the Highest, Lowest, and Total Freight Values from the Order Sales transactions. These calculations are applied to the records corresponding to the Employee ID selected in the cboEmp ComboBox.

When an OptionGroup button is clicked, the corresponding Freight value is retrieved from the filtered OrderDetailQ1 data using the appropriate domain aggregate function — DMax(), DMin(), or DSum(). The calculated result is then displayed in the Rslt TextBox, positioned to the left of the OptionGroup control.

The category description of the displayed Freight value is retrieved from the Cap() array, based on the selected OptionGroup control’s Radio Button index. This text is then passed as a parameter to the Animate() subroutine, which displays it on the Label control located to the left of the Rslt TextBox. The text is revealed in an animated style, character by character, moving from right to left until the full description is displayed.

The statement If strText = Cap(n) Then Exit Sub ignores the Animation from repeating when clicked on the Body of the OptionGroup Frame.

The Label Animation.

The Animate() Subroutine Code segment is given below:

Private Sub Animate(ByVal txt As String)
'Label Animation
Dim L As Double
Dim n As String
Dim T As Double
Dim j As Integer

L = Len(txt)
txt = Space(L) & txt 'Add spaces at the left side

For j = 1 To Len(txt) - L
 n = Left(txt, 1)
 txt = Right(txt, Len(txt) - 1)
 txt = txt & n
 frm.lblResult.Caption = Left(txt, L)
 
 Delay 0.02 ' Pause 20 Milliseconds
 
 Next
End Sub

The length of the Parameter value in the Variable txt is calculated and stored in variable L. The parameter variable txt content is modified by adding an equal number of spaces to its original length on the left side.

The Animation Sequence.

The For…Next loop runs up to the original string length stored in variable L. In each iteration, one character is removed from the left side of the string and appended to its right end. The leftmost L characters are then assigned to the Caption property of the lblResult Label control.

After updating the label, the loop introduces a 20-millisecond delay before proceeding to the next iteration. This process repeats until the full description is displayed on the Label control, creating the scrolling animation effect.

The Delay() Function VBA Code in the Standard Module is given below for information:

Public Sub Delay(ByVal Sleep As Double)
Dim T As Double

T = Timer
Do While Timer < T + Sleep
    DoEvents
Loop
End Sub

The OptObject_Init Class Module VBA Code.

Option Compare Database
Option Explicit

Private iFrm As Access.Form

Private LstB As OptListBox
Private txt As OptTextBox
Private Fram As OptFrame
Private wcbo As optCombo
Private wcmd As OptCmdButton

Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Combo and Option Group Controls
'Author: a.p.r. pillai
'Date  : 31/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get m_Frm() As Form
    Set m_Frm = iFrm
End Property

Public Property Set m_Frm(ByRef mfrm As Form)
    Set iFrm = mfrm
    
    iFrm.cboEmp.DefaultValue = iFrm.cboEmp.Column(0, 1)
    iFrm.List0.Requery

Call Class_Init
End Property

'Events Enabling Subroutine
Private Sub Class_Init()
Dim ctl As Control

Const EP = "[Event Procedure]"


For Each ctl In iFrm.Controls 'Scan for Controls

    Select Case TypeName(ctl)
            Case "OptionGroup"
              Select Case ctl.Name
                Case "Frame7" 'Option Group Name
                    Set Fram = New OptFrame 'Create Instance
                    Set Fram.opt_Frm = iFrm 'Assign Form Object
                    Set Fram.o_opt = ctl   'TextBox
                    
                        Fram.o_opt.OnClick = EP
                        
                    Coll.Add Fram 'Save EmpTextBox Class
                    Set Fram = Nothing 'Erase temp Instance
              End Select


        Case "ComboBox"
                    Set wcbo = New optCombo
                    Set wcbo.cbo_Frm = iFrm
                    Set wcbo.c_cbo = ctl
                    
                   wcbo.c_cbo.AfterUpdate = EP
                   wcbo.c_cbo.OnGotFocus = EP
                   wcbo.c_cbo.OnLostFocus = EP
                    
                    Coll.Add wcbo
                    Set wcbo = Nothing

        Case "TextBox"
                    Set txt = New OptTextBox
                    Set txt.tx_Frm = iFrm
                    Set txt.t_Txt = ctl
                    
                        txt.t_Txt.OnGotFocus = EP
                        txt.t_Txt.OnLostFocus = EP
                    
                    Coll.Add txt
                    Set txt = Nothing
                    
        Case "ListBox"
                    Set LstB = New OptListBox
                    Set LstB.lst_Frm = iFrm
                    Set LstB.m_Lst = ctl
                    
                        LstB.m_Lst.OnGotFocus = EP
                        LstB.m_Lst.OnLostFocus = EP
                    
                    Coll.Add LstB
                    Set LstB = Nothing
                    
        Case "CommandButton"
                    Set wcmd = New OptCmdButton
                    Set wcmd.cmd_Frm = iFrm
                    Set wcmd.c_cmd = ctl
                    
                   wcmd.c_cmd.OnClick = EP
                    
                    Coll.Add wcmd
                    Set wcmd = Nothing
    
    End Select
Next

End Sub

Private Sub Class_Terminate()
'Delete Collection Object contents
    Do While Coll.Count > 0
        Coll.Remove 1
    Loop
    
    Set iFrm = Nothing
End Sub

As with the other Access Object Wrapper Classes, all required objects are declared as Properties in the global area of the Module, followed by their respective Property Procedures.

Once the Form object is assigned to the internal iFrm object in the Set m_frm() Property Procedure, two initialization statements are executed to refresh the ComboBox and ListBox controls, ensuring they load their default values when the form is opened.

After these initializations, the Class_Init() A subroutine is called to complete the setup of the wrapper class.

The procedures written there are explained in detail in earlier episodes, and I am sure you are well-versed in the procedure.

It is worth noting that on the Form, there is only one instance of each control type: ComboBox, ListBox, TextBox, CommandButton, OptionGroup Control, and Chart Object.

Although the Chart object also exposes several events, just like the other controls, it is usually not given as much attention. However, if required, these events can be captured and managed in the same way by creating a dedicated Wrapper Class Module for the Chart control. This ensures the Chart’s interactions and behaviors can also be centralized, making the coding style fully consistent across all Form objects.

When to create a Wrapper Class?

There may be multiple instances of a particular control type on a Form (for example, several TextBox controls). In such cases, using Wrapper Classes becomes essential to capture and manage their individual events in a structured manner.

However, if there is only a single instance of a control type on the Form that requires one or more event procedures, then creating a dedicated Wrapper Class is not strictly necessary. Instead, you can:

Declare the control as a property in the OptObject_Init Class Module (the intermediate class), qualified with the WithEvents keyword.
Assign the control’s reference from the Form within the initialization routine.
Enable its events and write the required event procedures directly in the OptObject_Init Class Module.

This approach keeps the codebase cleaner by avoiding unnecessary Wrapper Classes, while still maintaining event-driven consistency for all controls.

Since the OptionGroup Control (Frame7) is a new addition in the Streamlining Form Module Code series, we created a dedicated Wrapper Class (OptFrame) for it.

For the other controls on the Form (ComboBox, ListBox, TextBox, and Command Button), only a single instance of each exists. Therefore, instead of creating separate Wrapper Classes, we declare them as single instances in the OptObject_Init Class Module, qualified with the WithEvents keyword.

These controls are then enabled with their required events, and their event subroutines are written directly in the intermediate class module (OptObject_Init), keeping the design lightweight and avoiding unnecessary Wrapper Classes.

Even though we have already created and used Wrapper Classes for these Objects earlier, using them in this case involves more VBA Code than necessary for a single instance of those Objects.

So, I created two Forms for Demo purposes:

frm_OptionGroup - All Control's Wrapper Classes are used in the OptObject_Init Class

frm_OptionGroup2 - Only Opt_Frame Wrapper Class is in the Opt_Object_Init2 Class.

The Opt_Object_Init2 Class Module Code.

The frm_OptionGroup2 Form's Intermediate Class Module (Opt_Object_Init2) Code is given below:

Option Compare Database
Option Explicit

Private WithEvents txt As Access.TextBox
Private WithEvents cmd As Access.CommandButton
Private WithEvents cbo As Access.ComboBox
Private WithEvents Lst As Access.ListBox

Private Fram As Opt_Frame2
Private iFrm As Access.Form
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Combo and Option Group Controls
'Author: a.p.r. pillai
'Date  : 31/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get m_Frm() As Form
    Set m_Frm = iFrm
End Property

Public Property Set m_Frm(ByRef mfrm As Form)
    Set iFrm = mfrm
    
    iFrm.cboEmp.DefaultValue = iFrm.cboEmp.Column(0, 1)
    iFrm.List0.Requery
    
    Set txt = iFrm.Result
    Set cmd = iFrm.cmdClose
    Set cbo = iFrm.cboEmp
    Set Lst = iFrm.List0
    
Call Class_Init
End Property

'Events Enabling Subroutine
Private Sub Class_Init()
Dim ctl As Control

Const EP = "[Event Procedure]"

'Scan for Form Controls
'and Enable the required Event Procedures
For Each ctl In iFrm.Controls 'Find TextBox, ComboBox & CommandButtons

    Select Case TypeName(ctl)
            Case "OptionGroup"
              Select Case ctl.Name
                Case "Frame7" 'Option Group Name
                    Set Fram = New Opt_Frame2 'Create Instance
                    Set Fram.opt_Frm = iFrm 'Assign Form Object
                    Set Fram.o_opt = ctl   'TextBox
                    
                        Fram.o_opt.OnClick = EP
                        
                    Coll.Add Fram 'Save EmpTextBox Class
                    Set Fram = Nothing 'Erase temp Instance
              End Select

        Case "CommandButton"
                   cmd.OnClick = EP
                    

        Case "ComboBox"
                   cbo.AfterUpdate = EP
                   cbo.OnGotFocus = EP
                   cbo.OnLostFocus = EP
          
        Case "TextBox"
            Select Case ctl.Name
                Case "Result"
                   txt.OnGotFocus = EP
                   txt.OnLostFocus = EP
            End Select
                    
        Case "ListBox"
                Lst.OnGotFocus = EP
                Lst.OnLostFocus = EP
                        
    End Select
Next

End Sub

Private Sub Class_Terminate()
'Delete Collection Object contents
    Do While Coll.Count > 0
        Coll.Remove 1
    Loop
    
    Set iFrm = Nothing
End Sub

'Event Subroutines
Private Sub txt_GotFocus()
        GFColor iFrm, txt 'Field Highlight
End Sub

Private Sub txt_LostFocus()
    LFColor iFrm, txt 'Field Highlight
End Sub

Private Sub cmd_Click()
    If MsgBox("Close " & iFrm.Name & " Form?", vbYesNo + vbQuestion, "cmd_Click") = vbYes Then
        DoCmd.Close acForm, iFrm.Name
        Exit Sub
    End If
End Sub

Private Sub cbo_GotFocus()
    GFColor iFrm, cbo 'ComboBox highlight
    
    'Reset OptionGroup to default settings
    iFrm.Frame7 = Null 'Reset earlier selection of OptionGroup option
    iFrm!lblResult.Caption = "Result"
    iFrm.Result.Value = 0
    
End Sub

Private Sub cbo_LostFocus()
    LFColor iFrm, cbo 'ComboBox highlight
End Sub

Private Sub cbo_AfterUpdate()
  iFrm.List0.Requery
  
End Sub

'Event Subroutines Code
Private Sub lst_GotFocus()
    GFColor iFrm, Lst 'ListBox highlight
End Sub

Private Sub lst_LostFocus()
    LFColor iFrm, Lst 'ListBox highlight
End Sub

Segmentwise Review of the VBA Code.

The Global Declaration Code segment is given below for review:

Option Compare Database
Option Explicit

Private WithEvents txt As Access.TextBox
Private WithEvents cmd As Access.CommandButton
Private WithEvents cbo As Access.ComboBox
Private WithEvents Lst As Access.ListBox

Private Fram As Opt_Frame2
Private iFrm As Access.Form
Private Coll As New Collection

All single-instance control declarations are placed in the global area of the module, just as we did at the beginning of this tutorial series.

Since the OptionGroup Control is a new addition, its dedicated Wrapper Class is included here.

Following this, the Form and Collection Object declarations are defined. The Collection Object is required only for the OptionGroup Control (Frame7), as it manages its wrapper class instances.

The Property Procedure Segment.

Next, the iFrm's Property Procedure Code Segment is given below:

'Form's Property GET/SET Procedures
Public Property Get m_Frm() As Form
    Set m_Frm = iFrm
End Property

Public Property Set m_Frm(ByRef mfrm As Form)
    Set iFrm = mfrm
    
    'Set the ComboBox EmployeeID first item as default value
    iFrm.cboEmp.DefaultValue = iFrm.cboEmp.Column(0, 1)
    iFrm.List0.Requery 'Refresh the Order Details ListBox
    
    Set txt = iFrm.Result
    Set cmd = iFrm.cmdClose
    Set cbo = iFrm.cboEmp
    Set Lst = iFrm.List0
    
Call Class_Init
End Property

In the Set m_Frm() Property Procedure, the ComboBox and ListBox are initialized with their default values when the Form is opened.

After that, references for all the single-instance controls on the Form are assigned to the corresponding object variables declared in the global area. Finally, the Class_Init() Subroutine is called to complete the setup.

The Class_Init() Subroutine.

'Events Enabling Subroutine
Private Sub Class_Init()
Dim ctl As Control

Const EP = "[Event Procedure]"

'Scan for Form Controls
'and Enable the required Event Procedures
For Each ctl In iFrm.Controls 'Find TextBox, ComboBox & CommandButtons

    Select Case TypeName(ctl)
            Case "OptionGroup"
              Select Case ctl.Name
                Case "Frame7" 'Option Group Name
                    Set Fram = New Opt_Frame2 'Create Instance
                    Set Fram.opt_Frm = iFrm 'Assign Form Object
                    Set Fram.o_opt = ctl   'TextBox
                    
                        Fram.o_opt.OnClick = EP
                        
                    Coll.Add Fram 'Save EmpTextBox Class
                    Set Fram = Nothing 'Erase temp Instance
              End Select

        Case "CommandButton"
                   cmd.OnClick = EP
                    

        Case "ComboBox"
                   cbo.AfterUpdate = EP
                   cbo.OnGotFocus = EP
                   cbo.OnLostFocus = EP
          
        Case "TextBox"
            Select Case ctl.Name
                Case "Result"
                   txt.OnGotFocus = EP
                   txt.OnLostFocus = EP
            End Select
                   
        Case "ListBox"
                Lst.OnGotFocus = EP
                Lst.OnLostFocus = EP
                        
    End Select
Next

End Sub

The Class_Init() Subroutine begins in the usual way by scanning the Form for its controls. When it identifies the OptionGroup control (Frame7), the Click Event is enabled, and the control is then added to the Collection Object.

The references for the other Form controls have already been assigned in the Set m_frm() Property Procedure. Their Events are also enabled at this stage, and the corresponding Event Subroutine code will be written directly in this Class Module.

In the case of the TextBox, there is another control named EID, which is kept hidden on the Form. Although hidden, it still appears during the scanning cycle and is enabled with Events. Since no Event Procedure code exists for this TextBox in the current Module, it has no impact on functionality. However, for clarity, we explicitly check for the specific Result TextBox and enable its Events, thereby ignoring the hidden EID TextBox. Following this, the ListBox is also enabled with the required Events.

The Event Subroutines of Single Control Instance Cases.

Next, the Event Subroutines Segment Code, which runs in the Opt_Object_Init2 Class.

'Event Runs automatically when the Form is Closed.
Private Sub Class_Terminate()
'Delete Collection Object contents
    Do While Coll.Count > 0
        Coll.Remove 1
    Loop
    
    Set iFrm = Nothing
End Sub

'TextBox Event Subroutines for highlighting the control
Private Sub txt_GotFocus()
        GFColor iFrm, txt 'Field Highlight
End Sub

Private Sub txt_LostFocus()
    LFColor iFrm, txt 'Field Highlight
End Sub

'Command Button Subroutines
Private Sub cmd_Click()
    If MsgBox("Close " & iFrm.Name & " Form?", vbYesNo + vbQuestion, "cmd_Click") = vbYes Then
        DoCmd.Close acForm, iFrm.Name
        Exit Sub
    End If
End Sub

'ComboBox Subroutines
Private Sub cbo_GotFocus()
    GFColor iFrm, cbo 'ComboBox highlight
    
    'Reset OptionGroup to default settings
    iFrm.Frame7 = Null 'Reset earlier selection of OptionGroup option
    iFrm!lblResult.Caption = "Result"
    iFrm.Result.Value = 0
    
End Sub


Private Sub cbo_LostFocus()
    LFColor iFrm, cbo 'ComboBox highlight
End Sub

Private Sub cbo_AfterUpdate()
  iFrm.List0.Requery
  
End Sub

'ListBox Event Subroutines Code
Private Sub lst_GotFocus()
    GFColor iFrm, Lst 'ListBox highlight
End Sub

Private Sub lst_LostFocus()
    LFColor iFrm, Lst 'ListBox highlight
End Sub

All Event Subroutines are written with the Object Name declared in the Global Declaration Area in the Opt_Object_Init2 Class Module.

Demo Database Download

Streamline11.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form Module Code - Part Ten

2023-08-19T11:09:00.024+05:30

Creating an Access Menu using TabControl, ListBox, and Command Buttons.

We will take up the TabControl-based Menu design task after a few minutes.

Organizing the Wrapper Classes for Different Forms.

Let us now look at how to organize wrapper classes when working with multiple forms, each requiring several wrapper classes within the same database. Proper organization is essential to avoid mistakes—for example, accidentally adding a wrapper class that contains the event subroutines of Form A into the WrapObject_Init class of Form B. Wrapper Class Templates.

Create a standard set of wrapper class templates for all frequently used controls, such as TextBoxes, CommandButtons, ComboBoxes, and others. When implementing them for a specific form, make copies of these classes and rename them using a short, meaningful prefix that identifies the form. For example, for the Employees form, the prefix Emp can be used: EmpTextBox, EmpCmdButton, EmpComboBox, and so on. This naming convention clearly associates each wrapper class with its corresponding form, helping to maintain consistency across the project.

After reviewing the previous nine articles on streamlining form module VBA code, you should now be familiar with this new coding approach and understand how to create a new wrapper class whenever a required template is not already available—such as when a new control is added to the form.

Forms With SubForms.

Forms with subforms do not require separate wrapper classes; a single wrapper class for the main form is sufficient. For example, in Episode Nine, the Employees main form with the Orders subform demonstrates this approach. In the EmpObject_Init class, the TextBox and ComboBox controls on the subform are scanned within a separate For…Next loop using the subform reference. These subform controls are then mapped and added to the collection object.

Their event subroutines can be accessed through the main form property. For instance, the EmpTextBox wrapper class property name Txt can be used to reference a TextBox on the Orders subform, as shown below:

'Data Update Reconfirm to Save the Change
Private Sub txt_BeforeUpdate(Cancel As Integer)
Dim msg As String

msg = "Field Name: " & Txt.Name & vbCr & _
        "Original Value '" & UCase(Txt.OldValue) & "'" & _
        vbCr & "Change to: '" & UCase(Txt.Value) & "'"
    
    If MsgBox(msg, vbYesNo + vbQuestion, _
        Txt.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
    End If


End Sub

The Txt object will hold the correct reference to the subform TextBox and will execute the corresponding code for that control in the Orders subform.

For example, consider the Txt_GotFocus() event subroutine. The following demonstration shows how to prevent the OrderDate TextBox on the Orders subform (within the Employees main form) from being highlighted when it receives focus.

Private Sub txt_GotFocus()
    If Txt.Name = "OrderDate" Then
         'No highlight
    Else
          GFColor frm, Txt
    End If
End Sub

We can reference a subform control just like any other control on the main form. In this case, the OrderDate field is excluded from highlighting when it becomes the current control.

The next sample code demonstrates how to skip highlighting all TextBoxes on the Orders subform.

Private Sub txt_GotFocus()
'https://learn.microsoft.com/en-us/office/vba/api/access.subform.parent
   Select Case Txt.Parent.Name         
    	Case "Orders"   'Orders SubForm has the parent Property set
          'Do Nothing
    	Case Else
           GFColor frm, Txt 'Field Highlight
   End Select
End Sub

Some examples of Wrapper Class Names are given below.

Wrapper Classes for the Employees Form.

EmpObject_Init
EmpTextBox
EmpCmdButton
EmpComboBox
EmpOptionGrp

Wrapper Classes for Orders Main Form.

Order_Object_Init
Order_TextBox
Order_CmdButton
Order_ListBox
Order_TabCtl

Reusing Streamlined Coding Procedures in Other Projects.

Now the Question of how to Reuse the Classes in another Database?

Different Projects and different requirements. Most of the Subroutines written for a particular Form, based on its specific requirements, cannot be used without changes in another Project. However, Event Subroutine Codes mentioned earlier (TextBox highlight, OnDirty, OnBeforeUpdate) or similar tasks can be used without modification in other Projects.

In both cases, the backbone of this new streamlined coding approach—using minimal code within wrapper classes—can be easily exported and reused in other projects. By handling coding through wrapper classes independently, without mixing it with form design tasks, development becomes more organized, and projects can be completed much faster.

You can create a set of Wrapper Class Templates for frequently used Form Controls, like:

Access.TextBox
Access.CommandButton
Access.ComboBox and others

Reusable event subroutines—such as OnGotFocus and OnLostFocus for highlighting controls, or OnDirty and BeforeUpdate for safeguarding against unintended changes—can be incorporated directly into the wrapper class templates for TextBoxes, ComboBoxes, ListBoxes, and other controls. Additionally, any common functions defined in standard modules that are used within these event subroutines (for example, the GFColor and LFColor functions for highlighting TextBox controls) should be included alongside the wrapper classes to ensure they work seamlessly.

Each wrapper class we create will include both a Form property and a Control object property (such as a TextBox), along with the corresponding Set, Get property procedures for these objects as the core of the class.

The wrapper class templates can be stored in a separate database for reuse. Classes saved in this database can follow the standard .cls prefix naming convention, for example:

clsObject_Init
clsTextBox
clsCmdButton and others.

How to use the Code from the Template Database.

Attach this database to your New Project as a Library database.
Create a new Class Module in the new Database.
Change its name to match the first Wrapper Class in the attached database.
Right-click on the Wrapper Class Module of the attached Database and select View Code from the displayed shortcut Menu. The Code will be displayed in the VBA Window.
Copy the Code and paste it into the new Class Module and save it.
Repeat this procedure to transfer all the Wrapper Class Templates to the New Database.
Then remove the attached database from the Reference Library.

Alternative Method.

An even better approach is to export the wrapper class templates from the VBA editor into a dedicated folder on your disk as individual class files with the .cls extension. These files can then be imported into new projects.

Access Menu with TabControl.

The finished Menu View Image is given below:

There are three layers of menu options—Tables, Forms, and Reports—which appear in the same area when selected by clicking the corresponding command buttons on the left side. The Menu Design Image is given below.

Each tab page includes a ListBox control of identical size, positioned at the same left and top coordinates. The purpose of this design is to display the menu pages, Tables, Forms, and Reports, one after another in the same location within the Tab Control.

The following property settings adjust the appearance of the Tab Control to match the style shown in the first image above:

Tab Style: None
Back Style: Transparent
Border Style: Transparent

When the tab pages are hidden, clicking a command button switches the active page, triggering the PageChange event. The button’s Click event also highlights its border to indicate the current selection. In addition, the selected menu option is announced by a female voice.

Double-clicking a list item will open the corresponding Table, Form, or Report on the screen, while also announcing the type of object currently being displayed.

The ListBox menu items, Employees, Orders, and Customers, are added to the value list in the following format:

1;"Employees";2;"Orders";3;"Customers"

for all three Menus, Tables, Forms, and Reports.

The TabLst_Object_Init Class

The TabLst_Objectr_Init Class Module Code is given below:

Option Compare Database
Option Explicit

Private iFrm As Access.Form
Private Coll As New Collection

Private tbc  As TabLst_TabCtl
Private wcmd As TabLst_CmdButton
Private lst  As TabLst_ListBox

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Tab Control Class_Init Class
'Author: a.p.r. pillai
'Date  : 16/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get m_Frm() As Form
    Set m_Frm = iFrm
End Property

Public Property Set m_Frm(ByRef mfrm As Form)
    Set iFrm = mfrm
	Call Class_Init
End Property

'Events Enabling Subroutine
Private Sub Class_Init()
Dim ctl As Control

Const EP = "[Event Procedure]"

'Scan for Tab Control, CommandButton & ListBox Controls
'and Enable the required Event Procedures
For Each ctl In iFrm.Controls

    Select Case ctl.ControlType
        Case acTabCtl
            Set tbc = New TabLst_TabCtl
            Set tbc.tb_Frm = iFrm
            Set tbc.tb_tab = ctl
                tbc.tb_tab.OnChange = EP
                
                Coll.Add tbc
            Set tbc = Nothing
    
        Case acListBox
            Set lst = New TabLst_ListBox
            Set lst.lst_Frm = iFrm
            Set lst.m_lst = ctl
            
            lst.m_lst.OnDblClick = EP
           
            Coll.Add lst
            Set lst = Nothing

        Case acCommandButton
            Select Case ctl.Name
                Case "cmdTables", "cmdForms", "cmdReports", "cmdExit"
                    Set wcmd = New TabLst_CmdButton
                    Set wcmd.cmd_Frm = iFrm
                    Set wcmd.c_cmd = ctl
                    
                    wcmd.c_cmd.OnClick = EP
                    Coll.Add wcmd
                    Set wcmd = Nothing
            End Select
            
   End Select
Next

End Sub

Private Sub Class_Terminate()
'Delete Collection Object contents
    Do While Coll.Count > 0
        Coll.Remove 1
    Loop
    
    Set iFrm = Nothing
End Sub

In the global declaration area, the Form and Collection properties are declared first, followed by the property declarations for the Tab Control, Command Button, and ListBox wrapper classes.

Next come the Set and Get property procedures for the form. The Class_Init() subroutine is called from the Set property procedure of the form object. Within the For… Next loop, the code identifies the TabCtl, ListBox, and CommandButton controls.

The TabCtl control wrapper class (TabLst_TabCtl) instance properties—tb_Frm and tb_Tab—are assigned the references iFrm and ctl, respectively. The TabCtl control’s TabPageChange event is then enabled, and the TabLst_TabCtl wrapper class instance is added to the collection object.

All three ListBox properties are enabled with the DblClick() event in their respective TabLst_ListBox wrapper class instances and then added to the collection object. Similarly, the CommandButton wrapper class (TabLst_CmdButton) instances are enabled with the Click event and added to the collection object.

The TabLst_TabCtl Class

The TabLst_TabCtl Wrapper Class Module Code is given below.

Option Compare Database
Option Explicit

Private tbfrm As Access.Form
Private WithEvents Tb As Access.TabControl

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'TabCtl Wrapper Class
'Author: a.p.r. pillai
'Date  : 16/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get tb_Frm() As Form
    Set tb_Frm = tbfrm
End Property

Public Property Set tb_Frm(ByRef tabfrm As Form)
    Set tbfrm = tabfrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get tb_tab() As Access.TabControl
    Set tb_tab = Tb
End Property

Public Property Set tb_tab(ByRef ptab As Access.TabControl)
    Set Tb = ptab
End Property

'Event Subroutines Code
Private Sub tb_Change()
   Select Case Tb.Value
        Case 0
            MsgBox "Change Event: Page(0)"
        Case 1
            MsgBox "Change Event: Page(1)"
        Case 2
            MsgBox "Change Event: Page(2)"
    End Select
End Sub

When the TabControl TabPageChange event is fired, it is captured here, and the page index number is displayed in a MsgBox.

The Command Button Wrapper Class.

 
Option Compare Database
Option Explicit

Private WithEvents cmdfrm As Form
Private WithEvents cmd As CommandButton 'CommandButton object
Dim L As Integer
Dim ForeColor As Long

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Command Button Events
'Author: a.p.r. pillai
'Date  : 16/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cmd_Frm() As Form
    Set cmd_Frm = cmdfrm
End Property

Public Property Set cmd_Frm(ByRef cfrm As Form)
    Set cmdfrm = cfrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get c_cmd() As CommandButton
    Set c_cmd = cmd
End Property

Public Property Set c_cmd(ByRef pcmd As CommandButton)
    Set cmd = pcmd
End Property

'Event Subroutines
Private Sub cmd_Click()
Select Case cmd.Name
  Case "cmdExit"
  Announce "Close the Form Now?"
    If MsgBox("Close the Form Now?", vbOKCancel + vbQuestion, "cmd_Click") = vbOK Then
        DoCmd.Close acForm, cmdfrm.Name
        Exit Sub
    End If
    
  Case "cmdTables"
    'Command Button Border Highlight
      cmd.BorderWidth = 2
      cmdfrm.cmdForms.BorderWidth = 0
      cmdfrm.cmdReports.BorderWidth = 0
      
    cmdfrm.TabCtl0.Pages(0).SetFocus
    Announce "Tables Menu Active."
    
  Case "cmdForms"
    'Command Button Border Highlight
    cmd.BorderWidth = 2
    cmdfrm.cmdTables.BorderWidth = 0
    cmdfrm.cmdReports.BorderWidth = 0
    
    cmdfrm.TabCtl0.Pages(1).SetFocus
        Announce "Forms Menu Active."

  Case "cmdReports"
  'Command Button Border Highlight
    cmd.BorderWidth = 2
    cmdfrm.cmdForms.BorderWidth = 0
    cmdfrm.cmdTables.BorderWidth = 0
    
    cmdfrm.TabCtl0.Pages(2).SetFocus
        Announce "Reports Menu Active."
End Select
End Sub

The three command buttons on the left side of the TabControl serve as replacements for the default TabControl page buttons, effectively hiding the TabControl’s built-in navigation features. This technique allows multiple layers of different menus to appear one at a time in the same location. Additional menu layers can also be added to the TabControl using ListBoxes and command buttons.

The following TabControl property settings are applied to hide its default features:

Style: None
Back Style: Transparent
Border Style: Transparent

The ListBox Wrapper Class.

Option Compare Database
Option Explicit

Private lstfrm As Access.Form
Private WithEvents lst As Access.ListBox

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'ListBox Wrapper Class
'Author: a.p.r. pillai
'Date  : 16/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get lst_Frm() As Form
    Set lst_Frm = lstfrm
End Property

Public Property Set lst_Frm(ByRef mFrm As Form)
    Set lstfrm = mFrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get m_lst() As ListBox
    Set m_lst = lst
End Property

Public Property Set m_lst(ByRef mLst As ListBox)
    Set lst = mLst
End Property

Private Sub lst_DblClick(Cancel As Integer)
Dim i As Integer
Dim Menu(1 To 3) As String
Dim Obj(1 To 3) As String

i = Nz(lst.Value, 0)

Const Opn = "Opening "

Menu(1) = "Table "
Menu(2) = "Form "
Menu(3) = "Report "

Obj(1) = "Employees"
Obj(2) = "Orders"
Obj(3) = "Customers"

Select Case lst.Name
    Case "LstTables"
        Select Case i
            Case 1, 2, 3
                Announce Opn & Menu(1) & Obj(i) 'Speak
                DoCmd.OpenTable Obj(i), acViewNormal
        End Select
        
    Case "LstForms"
        Select Case i
            Case 1, 2, 3
                Announce Opn & Menu(2) & Obj(i) 'Speak
                DoCmd.OpenForm Obj(i), acViewNormal
        End Select
        
    Case "LstReports"
        Select Case i
            Case 1, 2, 3
                Announce Opn & Menu(3) & Obj(i) 'Speak
                DoCmd.OpenReport Obj(i), acViewReport
        End Select
End Select
End Sub

At the beginning of the ListBox Double-Click Event Subroutine, a few array variables are initialized with the menu names and corresponding menu item names. These arrays are then used to compose the speech text that announces the selected menu item. This approach also simplifies the code by reducing the number of file-opening statements from six lines to just two for each object type—Tables, Forms, and Reports (excluding the array initialization lines).

The normal Coding will look like the following:

Select Case lst.Name
    Case "LstTables"
        Select Case i
            Case 1
                Announce "Opening Table Employees" 'Speak
                DoCmd.OpenTable "Employees", acViewNormal
            Case 2
                Announce "Opening Table Orders" 'Speak
                DoCmd.OpenTable "Orders", acViewNormal
            Case 3
                Announce "Opening Table Customers" 'speak
                DoCmd.OpenTable "Customers", acViewNormal
        End Select
        
    Case "LstForms"
        Select Case i
            Case 1
                Announce "Opening Form Employees" 'Speak
                DoCmd.OpenForm "Employees", acViewNormal
            Case 2
                Announce "Opening Form Orders" 'Speak
                DoCmd.OpenForm "Orders", acViewNormal
            Case 3
                Announce "Opening Form Customers" 'speak
                DoCmd.OpenForm "Customers", acViewNormal
        End Select
        
    Case "LstReports"
        Select Case i
            Case 1
                Announce "Opening Report Employees" 'Speak
                DoCmd.OpenReport "Employees", acViewReport
            Case 2
                Announce "Opening Report Orders" 'Speak
                DoCmd.OpenReport "Orders", acViewReport
            Case 3
                Announce "Opening Report Customers" 'speak
                DoCmd.OpenReport "Customers", acViewReport

        End Select
End Select

Microsoft Speech-Service VBA Code is given below. The Subroutine Code is in the Standard Module.

Sub Announce(ByVal Txt As String, Optional Gender As String = "Female")
'https://learn.microsoft.com/en-us/azure/ai-services/speech-service/
    Dim obj As Object
    Set obj = CreateObject("SAPI.SpVoice")
    Set obj.Voice = obj.GetVoices("Gender = " & Gender).Item(0)
    obj.Speak Txt
End Sub

The TabLst_ListBox Wrapper Class DblClick() Event Subroutines Runs the Menu Options, Tables, Forms, and Reports, opening activities.

Streamline10.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form Module Code - Part Nine

2023-08-07T21:59:00.018+05:30

Introduction.

After working through the last eight episodes of this series, you are likely familiar with this new coding approach and its benefits. By using the stand-alone Class Module–based method, we can achieve greater functionality while writing significantly less VBA code.

Episode Seven demonstrated how to highlight an entire array of TextBoxes on the Form. The OnGotFocus() Subroutine highlights the active TextBox, while the LostFocus() Subroutine resets it to its original state. Remarkably, this was achieved with just six lines of VBA code in the WrapTextBox Class. The public functions GFColor() and 'LFColor()' in the Standard Module are called from the GotFocus() and LostFocus() Event Subroutines in the WrapTextBox Class, respectively.

Private Sub txt_GotFocus()
    GFColor frm, Txt 'Field Highlight
End Sub

Private Sub txt_LostFocus()
    LFColor frm, Txt 'Field Highlight
End Sub

If you add more TextBoxes on the Form or delete existing ones, and not necessary to make any changes to the VBA Code.

Similarly, the following code snippet tracks all TextBox controls on the Employees form, detecting any attempts to modify their values. This monitoring applies to every TextBox on both the main Employees form and the Orders subform.

The OnDirty Event Subroutine.

Private Sub txt_Dirty(Cancel As Integer)
    If MsgBox("Editing the " & UCase(Txt.Name) _
    & ": Value? " & Txt.Value, vbYesNo + vbQuestion, _
    Txt.Name & " DIRTY()") = vbNo Then
    
        Cancel = True
    End If
End Sub

The code snippet above monitors all TextBoxes on the main form, Employees, and its subform, Orders, to prevent unintended changes. When a user attempts to modify a field, a warning message appears, requiring confirmation before the edit can proceed. If the user recognizes the action as a mistake, they can cancel the event and restore the field to its original value. This approach helps prevent accidental modifications and maintains data integrity.

Right-click to open Large Image in New Tab/Window.

The TextBoxes on the Orders SubForm are also under the surveillance of this Code.

The BeforeUpdate Event Subroutine.

When data is modified and the Enter key is pressed, the BeforeUpdate event procedure is triggered, safeguarding all TextBox controls on the forms. These events are handled collectively within the single subroutine txt_BeforeUpdate(), as demonstrated in the code below.

'Data Update Reconfirm to Save the Change
Private Sub txt_BeforeUpdate(Cancel As Integer)

    If MsgBox("Field Name: " & Txt.Name & vbCr & _
        "Original Value '" & UCase(Txt.OldValue) & "'" & _
        vbCr & "Change to: '" _
        & UCase(Txt.Value) & "'", vbYesNo + vbQuestion, _
        UCase(Txt.Name) & " BeforeUpdate()?") = vbNo Then
    
        Cancel = True
    End If


End Sub

Right-click to open Large Image in New Tab/Window.

Again, the User has to reconfirm to save the data in the Field.

Reusability of Streamlined VBA Code Writing.

The key advantage of this streamlined VBA coding approach is reusability. Instead of writing separate event-handling code for each TextBox within the form module, you only need to define it once in a TextBox wrapper class module. This class module serves as a template for managing BeforeUpdate() events across all TextBox controls.

Here's how it works:

Write the BeforeUpdate event handling code in the TextBox Wrapper Class Module.
Instantiate the Wrapper Class Module for each TextBox in the Main Form and Subform.
Assign the references of the Form and TextBox controls to their corresponding properties in the Wrapper Class Module.
Enable the required event procedures (e.g., BeforeUpdate) in the Wrapper Class EmpObject_Init Module.
Store the instantiated Wrapper Class EmpTextBox in memory through the Collection Object.

By adopting this approach, you can efficiently manage events for multiple TextBoxes across different forms without duplicating code. It improves code organization, eliminates redundancy, and simplifies future maintenance and updates to the event-handling logic.

So far, we have not worked with an example involving a main form and subform together—specifically, how to reference controls on the subform, enable their events, and streamline the code for both forms.

In this episode, the Employees table will serve as the record source for the main form Employees. The subform Orders, based on the Orders table, is designed as a tabular form.

We will explore how to reference subform controls (both TextBox and ComboBox) within the EmpObject_Init wrapper class, enable their required events, and store the wrapper class instances in a collection object, just as we did earlier.

The Control Wrapper Class (EmpTextBox) instances, once enabled with their required events, remain in memory as items within the collection object. They capture events triggered by the TextBoxes on both the form and subform and execute the corresponding event subroutines.

In the last episode, we created a new Wrapper Class EmpCmdButton for the Command Button Class Object and added it as the Property of the EmpObject_Init Class.

This time, we need a new wrapper class, EmpCombo, for the ComboBox control to capture events triggered by ComboBoxes on both the main form and subform.

In the footer section of the Employees form, there is a TextBox control used to search for an employee record by EmployeeID as the search key.

After the search operation, a Label control will briefly flash (label animation) to indicate whether the search was successful, and then disappear.

The important question is: where should we place the code for the data search and record lookup, as well as the label animation?

If you recall from the previous episode (Part Eight), we implemented a form-close countdown display within the WrapCmdButton class, specifically inside the cmd_Click() event subroutine. The countdown was shown in a Label control on the form. Similarly, a digital clock was also displayed in a Label control, but the code that managed the form’s TimerInterval settings was executed from the WrapObject_Init wrapper class.

Similarly, another common task is handled in the footer section of the form. An unbound TextBox, FindIDTextBox, is provided for searching by EmployeeID. When a value is entered, it is used to locate the corresponding record on the Employees form. The key question is: in which wrapper class should we place the VBA code for the search and find operations?

Right-click to open Large Image in New Tab/Window.

Besides that, there is a Label Control below the FindID TextBox to display the result of the search operation.

Right-click to open Large Image in New Tab/Window.

The EmployeeID will be entered into the unbound FindID TextBox, followed by pressing the Enter key. This action should trigger a search for the matching EmployeeID record on the Employees form. The code can be placed in the TextBox AfterUpdate() or LostFocus() event subroutine. However, the record lookup itself should be performed on the form’s RecordsetClone.

Alternatively, a Command Button can be added next to the unbound TextBox to initiate the search. In that case, the code can be written in the Command Button’s Click event subroutine within the EmpCmdButton wrapper class.

To provide feedback, a Label control in the form’s footer will display an animated (On/Off) status message indicating whether the search was successful or not. Events that involve the Form Object.

Each wrapper class we create—such as EmpTextBox, EmpCmdButton, EmpCombo, and others—will include the form object as a property, defined either with or without the WithEvents declaration.

When declared with WithEvents (e.g., Private WithEvents frm As Form), the wrapper class can directly capture the form’s events. Without WithEvents, the form property can still be used to access its controls, allowing you to read or write values and work with control properties as needed.

Regardless of whether the form property is actively used, a reference to the physical form is assigned to all wrapper class instances within the Class_Init() subroutine of the intermediate classes, such as WrapObject_Init or EmpObject_Init.

For this reason, we prefer to place the FindID TextBox AfterUpdate() event subroutine code within the EmpTextBox wrapper class module.

First, let us see how to incorporate the FindID unbound TextBox’s AfterUpdate() event-enabling code into the EmpObject_Init wrapper class, within the existing implementation. The complete VBA code is provided below. In addition, the ComboBox wrapper class property (named CBO) and its event-enabling code have been added to the Class_Init subroutine. All newly added code lines are highlighted in red.

The WrapObject_Init class was copied from the earlier project, renamed as EmpObject_Init, and extended with the new code lines marked in red. The same approach applies to other classes. This method allows you to quickly create wrapper classes, reuse existing code for different forms, and apply modifications where necessary.

Option Compare Database
Option Explicit

Private WithEvents iFrm As Access.Form
Private WithEvents oFrm As Form

Private iTxt As EmpTextBox
Private wcbo As EmpCombo
Private wcmd As EmpCmdButton
Private Coll As New Collection

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Main Form SubForm with Data
'Author: a.p.r. pillai
'Date  : 06/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get m_Frm() As Form
    Set m_Frm = iFrm
End Property

Public Property Set m_Frm(ByRef mfrm As Form)
    Set iFrm = mfrm
Call Class_Init
End Property

'Events Enabling Subroutine
Private Sub Class_Init()
Dim ctl As Control

Const EP = "[Event Procedure]"
iFrm.OnTimer = EP  'Enable TimerInverval for Label Annimation

'Scan for TextBox, CommandButton & Combobox Controls on Employees Form
'and Enable the required Event Procedures
For Each ctl In iFrm.Controls 'Find TextBox, ComboBox & CommandButtons

    Select Case TypeName(ctl)
            Case "TextBox"
              Select Case ctl.Name
                Case "FindID" 'Employee ID Search TextBox
                    Set iTxt = New EmpTextBox 'Create Instance
                    Set iTxt.tx_Frm = iFrm 'Assign Form Object
                    Set iTxt.t_Txt = ctl   'TextBox
                    
                        iTxt.t_Txt.OnGotFocus = EP
                        iTxt.t_Txt.OnLostFocus = EP
                        iTxt.t_Txt.AfterUpdate = EP 'For EmployeeID Search
                        
                    Coll.Add iTxt 'Save EmpTextBox Class
                    Set iTxt = Nothing 'Erase temp Instance
                  GoTo CmdButton
              End Select

                    Set iTxt = New EmpTextBox 'Create Instance
                    Set iTxt.tx_Frm = iFrm
                    Set iTxt.t_Txt = ctl       'Pass TextBox Control on Form
 
                         iTxt.t_Txt.OnGotFocus = EP
                         iTxt.t_Txt.OnLostFocus = EP
                         iTxt.t_Txt.OnDirty = EP      'To warn against Data Change
                         iTxt.t_Txt.BeforeUpdate = EP 'Reconfirm Data Change to update
                        
                    Coll.Add iTxt 'Save EmpTextBox Class in Collection Object
                    Set iTxt = Nothing 'Erase temp Instance
CmdButton:
        Case "CommandButton"
            Select Case ctl.Name
                Case "cmdClose"
                    Set wcmd = New EmpCmdButton
                    Set wcmd.cmd_Frm = iFrm
                    Set wcmd.c_cmd = ctl
                    
                    wcmd.c_cmd.OnClick = EP
                    
                    Coll.Add wcmd
                    Set wcmd = Nothing
            End Select
        
        Case "ComboBox"
                    Set wcbo = New EmpCombo
                    Set wcbo.cbo_Frm = iFrm
                    Set wcbo.c_cbo = ctl
                    
                   wcbo.c_cbo.OnGotFocus = EP
                   wcbo.c_cbo.OnLostFocus = EP
                    
                    Coll.Add wcbo
                    Set wcbo = Nothing
    End Select
Next

'Order Sub-Form
  Set oFrm = iFrm.Orders.Form

For Each ctl In oFrm.Controls 'Scan for SubForm Control and enable Events
Select Case TypeName(ctl)
    Case "TextBox"

            Set iTxt = New EmpTextBox 'Create Instance
            Set iTxt.tx_Frm = oFrm
            Set iTxt.t_Txt = ctl       'Pass TextBox Control on Form

               iTxt.t_Txt.OnGotFocus = EP 'To highlght TextBox
               iTxt.t_Txt.OnLostFocus = EP 'Reset Highlight
               
               iTxt.t_Txt.OnDirty = EP
               iTxt.t_Txt.BeforeUpdate = EP
               
                Coll.Add iTxt 'Save EmpTextBox Class
            Set iTxt = Nothing 'Erase temp Instance

        Case "ComboBox"
             Set wcbo = New EmpCombo
             Set wcbo.cbo_Frm = oFrm
             Set wcbo.c_cbo = ctl

                 wcbo.c_cbo.OnGotFocus = EP 'To highlght ComboBox
                 wcbo.c_cbo.OnLostFocus = EP 'Reset Highlight
                     
                   Coll.Add wcbo
                Set wcbo = Nothing
    End Select
Next

End Sub

Private Sub Class_Terminate()
'Delete Collection Object contents
    Do While Coll.Count > 0
        Coll.Remove 1
    Loop
    
    Set iFrm = Nothing
    Set oFrm = Nothing
End Sub

The EmpTextBox Wrapper Class EmployeeID Search VBA Code is given below:

Option Compare Database
Option Explicit

Private WithEvents frm As Form
Private subFrm As Form

Private WithEvents Txt As TextBox 'TextBox object
Dim L As Integer
Dim ForeColor As Long
'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'Main Form SubForm with Data
'Author: a.p.r. pillai
'Date  : 06/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------
'Form's Property GET/SET Procedures
Public Property Get tx_Frm() As Form
    Set tx_Frm = frm
End Property

Public Property Set tx_Frm(ByRef pfrm As Form)
    Set frm = pfrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get t_Txt() As TextBox
    Set t_Txt = Txt
End Property

Public Property Set t_Txt(ByRef tTxt As TextBox)
    Set Txt = tTxt
End Property

'Evbent Subroutines
'===================

Private Sub txt_GotFocus()
    GFColor frm, Txt 'Field Highlight
    
    If Txt.Name = "FindID" Then
        Txt.Value = Null
    End If
End Sub

Private Sub txt_LostFocus()
    LFColor frm, Txt 'Field Highlight
End Sub

Private Sub txt_Dirty(Cancel As Integer)
    If MsgBox("Editing the " & UCase(Txt.Name) _
    & ": Value? " & Txt.Value, vbYesNo + vbQuestion, _
    Txt.Name & " DIRTY()") = vbNo Then
    
        Cancel = True
    End If
End Sub

'Data Update Reconfirm to Save the Change
Private Sub txt_BeforeUpdate(Cancel As Integer)
Dim msg As String

msg = "Field Name: " & Txt.Name & vbCr & _
        "Original Value '" & UCase(Txt.OldValue) & "'" & _
        vbCr & "Change to: '" & UCase(Txt.Value) & "'"
    
    If MsgBox(msg, vbYesNo + vbQuestion, _
        Txt.Name & "_BeforeUpdate()") = vbNo Then
        Cancel = True
    End If

End Sub

Private Sub txt_AfterUpdate()
Select Case Txt.Name
    Case "FindID"
        Dim rst As Recordset
        Dim ToFind As Integer
        Dim msg As String
        Dim max As Integer
        
        'max = DCount("*", "Employees")
        ToFind = Nz(frm!FindID, 0)
        If ToFind < 1 Then
            msg = "Employee ID: < 1 Invalid!"
            MsgBox msg, vbOK + vbCritical, Txt.Name & "_AfterUpdate()"
        Else
            Set rst = frm.RecordsetClone
            rst.FindFirst "EmployeeID=" & ToFind
            If Not rst.NoMatch Then
                frm.Bookmark = rst.Bookmark
        
                With frm.Result
                    .Caption = "*** Successful ***"
                    ForeColor = 16711680
                    .ForeColor = ForeColor
                End With
            Else
                With frm.Result
                    .Caption = "**Sorry, Not found!"
                    ForeColor = 255
                End With
            
            End If
            L = 0
            frm.TimerInterval = 250 'Enable Timer
        End If
    End Select
End Sub

'Label Animation Code.
Private Sub frm_Timer()
L = L + 1
Select Case L
    Case 1, 3, 5, 7, 9, 11, 13, 15, 17
        frm.Result.Visible = True
    Case 2, 4, 6, 8, 10, 12, 14, 16, 18
        frm.Result.Visible = False
    Case 19
       frm.Result.ForeColor = ForeColor
       frm.Result.Visible = False
       frm.TimerInterval = 0
End Select
End Sub

The EmpCombo is a new wrapper class for the ComboBox control. Its GotFocus() and LostFocus() event subroutine VBA code is shown below:

Option Compare Database
Option Explicit

Private cbofrm As Access.Form
Private WithEvents cbo As Access.ComboBox 'ComboBox object

'------------------------------------------------------
'Streamlining Form Module Code
'in Stand-alone Class Modules
'------------------------------------------------------
'ComboBox Wrapper Class
'Author: a.p.r. pillai
'Date  : 06/08/2023
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'------------------------------------------------------

'Form's Property GET/SET Procedures
Public Property Get cbo_Frm() As Form
    Set cbo_Frm = cbofrm
End Property

Public Property Set cbo_Frm(ByRef cfrm As Form)
    Set cbofrm = cfrm
End Property

'TextBox Property GET/SET Procedures
Public Property Get c_cbo() As ComboBox
    Set c_cbo = cbo
End Property

Public Property Set c_cbo(ByRef pcbo As ComboBox)
    Set cbo = pcbo
End Property

'Event Subroutines Code
Private Sub cbo_GotFocus()
    GFColor cbofrm, cbo 'ComboBox highlight
End Sub

Private Sub cbo_LostFocus()
    LFColor cbofrm, cbo 'ComboBox highlight
End Sub

Your Assessment of the Streamlined Coding Procedure in the Standalone Class Module.

If you are an experienced Access VBA programmer, you may be able to assess the following points:

The amount of work and time required to write OnDirty() event subroutines for each TextBox and ComboBox control on the Employees form and the Orders subform using the traditional, manual VBA coding approach.
Similarly, the effort is needed to implement the AfterUpdate() event subroutines across both forms.

In practice, we typically write such code in the form module only for essential controls. Considering this, how do you feel about the new method in terms of ease of implementation and time savings compared to conventional coding practices? The focus here is not on quantifying the savings but on the reusability of code in standalone class modules and the potential reduction in development time for future projects.

Although this new approach—streamlining form module coding into standalone class modules—may be harder for beginners to fully evaluate, as an expert VBA programmer, what is your perspective on its effectiveness?

All episodes are written in a tutoring style, with title-related examples, so that non-experts can follow along and try them out. From your experience, how easy or difficult is it for non-experts to understand these concepts?

You are welcome to leave your feedback in the comment section. If you have a Gmail account, you can log in to post your comments. Thank you!

The upcoming demonstrations on this topic will cover the implementation of other Access class objects—such as Tab Control, ListBox, and Option Group—as well as examples of streamlining report module code.

The Demo Database is attached for Download.

Streamline9.zip

LEARN MS-ACCESS TIPS AND TRICKS

Group-Wise Ranking Using Class Module

Group-Wise Ranking in Microsoft Access Using a Class Module

A Reusable Object-Oriented Approach.

Why Use a Class Module?

Design Overview

clsRankList

Wrapper Class Template Wizard V2

Streamlining Form Module Code in Standalone Class Module.

Class Module Template Creation Wizard V2.

How to Run the WrapperClassWizard from within a Database?

The Sample Click Event Subroutine Structure Code.

Opening the ClassWizard Form.

The ClassWizard Form Module Code:

The Wiz_ObjInit Intermediary Class Module VBA Code.

The ListBox Wrapper Class 'Wiz_ListBox' Module VBA Code.

The Command Button Wrapper Class 'Wiz_CmdButton' Module Code.

The CreateClassTemplate() Wizard Function VBA Code is given below:

Demo Databases Download.

Wrapper Class Module Creation Wizard

Streamlining Form Module Code in Standalone Class Module.

Wrapper Class Module Wizard.

The ClassWizard Form Image.

The BASIC Language Text File Creation, Writing/Reading Statements:

Read the Text Data into a Variable

The sample 'ClassTextBox_Template' VBA Code generated by the ClassTemplateWizard is listed below for reference.

The ClassTextBox_Template.

Steps to Create the Class Template File

Demo Databases Download.

Classes For All Data Entry Editing Forms

Streamlining Form Module Code in Standalone Class Module.

Ready-made Class Modules for Data-Entry, Editing, or Viewing.

The Class_ObjInit Class Module.

The Data_txtBox TextBox Class Module Code.

The Data_CboBox ComboBox Class Module Code.

Test Running the Form.

Data Entry, Editing, and Viewing.

Data Validation Checks.

The Form Module Code change is highlighted.

The Wrapper Class Declarations in the Emp_ObjInit Class Module.

Demo Database Download

Table Query Records in Collection Object

Class Module and Collection Object.

Steps to Create a Data View Form

The Ready-made Reusable DATA_View Class Module Code.

Data_View VBA Code Segment-wise Review.

The Global Declarations.

The cbo_Click() Event Subroutine.

Demo Database Download

Streamline Filter By Character Sort

Streamlining Form Module Code in Standalone Class Module.

Data Filter by Character and Sort on Form.

Example of Structured Event Subroutine Coding:

The Customers Form Image-1 Normal Data View.

Customers Form Image-2 with Filtered Data.

The Cls_ObjInit Class Module VBA Code.

The txt_KeyUp() Event Subroutine Code.

The Form Module Code.

Filter By Character in ComboBox Items.

Download Demo Database

Streamline Zoom-in Control Data Editing

Streamlining Form Module Code in Standalone Class Module.

Editing Large Text Box Contents in Zoom-in Control.

The Main Public Functions.

The ZoomOpen() Function.

The SaveZoomData() Function.

2. Create the Menu Macro.

The 'Shortcut Menu Bar' Property of Form and Controls.

The Zoom Form with txtZoom TextBox.

The Interface Class Module Cls_ObjInit

The Trial Runs.

The Employees Form Module VBA Code.

Download the Demo Database.

Streamlining Code Reminder Popup Form

Streamlining Form Module Code in Standalone Class Module.

Reminder Popup Form.

Introduction.

The Employees1 Table Image.

Reminder: Data Filtering Queries.

Reminder: POPUP Forms.