LEARN MS-ACCESS TIPS AND TRICKS

Streamlining Form Module VBA RGBColor Wizard

a.p.r. pillaiNovember 22, 2023 No comments

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 represent the Red, Green, and Blue color values, each ranging from 0 to 255. Together, these values generate a full RGB spectrum, thus enabling the creation of up to 16.7 million distinct colors.

The RGB Color Wizard Image is given below.

Let us take a look at the Color Wizard's User Interface.

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 individual color selected Red, Green, and Blue values, visually resembling a bar graph. The RGB() function then mixes 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 up to 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 and updates other related controls, such as the TextBox content on the left side. Additionally, it increases the width of the label controls and dynamically shows the color variations based on the selected color 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 persuaded 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 is possible, although the procedure is somewhat uncommon.

You can see how these Custom Properties are addressed for storing/retrieving data to/from them. For an introduction to this method, visit this Link: Saving Data on Forms, Not in a Table to see a simple, practical usage.

To preserve data from the ColorGrid, Text Boxes, and other controls during changes or when closing, we implemented custom properties to store this information.

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

'Read value from 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 values from the form's custom properties and assigns them to the labels, scroll bars, and text boxes.

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 single command button object 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 originally published in October 2010. The initial version featured a 15-color palette, with all wizard VBA code implemented in the form module. That original wizard form is included in the demo database named ColorPaletteOld. You are encouraged to open and review its code to see how it has been refactored into a form that can now be executed from a standalone class module VBA code associated with the ActiveX ScrollBar control.

Demo Database Download Link.

RGB_Colors.zip

Streamlining Form Module Code in Standalone Class Module.

Streamlining Event Procedures 3D-Text Wizard

a.p.r. pillaiNovember 11, 2023 No comments

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 for an automotive company in the Sultanate of Oman. At that time, the wizard demonstrated the QBColor version, providing a simple way to explore color effects.

The updated 3D Text Wizard now supports the full RGB color spectrum, making color selection significantly more flexible. To further enhance customization, a dedicated ColorList table has been added, allowing users to extend the available palette with their own preferred colors.

This feature is particularly useful for creating three-dimensional text effects for form headings or for displaying field values, such as employee names or product names. These enhancements make the displayed text more visually appealing and easier to distinguish, especially when viewed from a distance.

Example-1: Employee Name.

Right-click to open the Large Image in a New Window.

Example-2:Order Details Form View-2

Right-click to open the Large Image in a New Window.

The 3D Text Wizard Image is given below:

Right-click to open the Large Image in a New Window.

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 effect is created by layering multiple Label controls or Text Boxes, each displaying the same text. Alternatively, the effect can be produced manually by placing a label or text box with an attractive foreground color on top and positioning additional layers with a darker foreground color behind it, slightly offset toward one of the four corners—top-left, top-right, bottom-left, or bottom-right. This technique creates a shadow effect that enhances the visual appearance of the text.

Manually creating this effect each time can be both tedious and inefficient. As demonstrated in earlier articles, I created form headings using only two labels to achieve a simple yet effective 3D appearance.

On the left side of the Text Wizard interface is a ListBox that displays a collection of colors. This ListBox is bound to a table named Colors, allowing you to add additional color codes whenever required.

To the right of the Colors List are two Option Group controls. The upper Option Group contains two choices. When the first option button is selected, the color chosen from the ListBox is displayed in the upper rectangle control and is applied to the caption of the topmost Label or to the font color of the Text Box used to create the 3D text.

When the second option button is selected, the color chosen from the ListBox is applied as the border color in the first two Text Wizards—Border 2D and Border 3D. All other Text Style Wizard options use only the ForeColor property.

The 3D Text Shadow Positions.

At the top right, there is a ComboBox with four options (0-3) to specify the light and shadow positions 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 requires no additional configuration. For both the 2D and 3D text styles, the wizard generates the effect by creating five or seven labels with the same text but with different ForeColor values. These labels are positioned beneath the top label and slightly offset to produce the desired visual effect.

For the 2D border style, the underlying labels are positioned toward the four corners of the top label, creating the appearance of a border surrounding the text.

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.

Right-click to open the Large Image in a New Window.

The second option creates 3D text using Text Box controls. This style is particularly useful for displaying data from form or report fields by using expressions, as illustrated in the examples shown at the top of this page.

After selecting the desired options, click the Create 3D Text command button to generate the 3D text. The generated text is displayed in the Detail section of a new form. Beneath it, an instructional label provides guidance on modifying the text, font, font size, and font styles, such as Bold, Italic, and Underline, if required. To edit the generated text, carefully select the top Label or Text Box without changing its position, and then modify the label caption or the Text Box contents as needed.

After completing the modifications, select all the Label or Text Box controls by dragging a selection rectangle around them. Then copy and paste the entire group to the desired location.

To display data from form fields in the Text Box controls, assign an expression—such as `=[First Name] & " " & [Last Name]`—to the Control Source property after selecting all the Text Box controls that make up the 3D text.

After generating a text style, you can save it within the 3D Text Wizard for future use. It can then be imported into other projects and modified as required.

With the event procedures consolidated in a standalone intermediary class module, only a single wrapper class is required to handle all the Command Button controls on the form.

The form contains only one ListBox control, and its Click event is handled by a procedure in the intermediary class module.

Similarly, the form contains two Option Group controls. One is used to select the 3D text style, while the other manages the ForeColor and BackColor parameter selection. The BackColor option applies only to the first two text styles—2D and 3D Border. When either of these styles is selected, the BackColor option is enabled; otherwise, it remains disabled.

Because these actions are controlled through the Text Style Option Group, a separate wrapper class for the Option Group controls is unnecessary. The ListBox and Option Group controls are declared as object instances in the intermediary class module using the WithEvents keyword, allowing their events to be handled directly within that class.

The form also contains two ComboBox controls. One is used to select the required 3D text shadow option, while the other is used to choose whether the output should be created as a Label or a Text Box. These ComboBox controls do not require any event procedures.

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 Module's global area 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 Control 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.

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 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

a.p.r. pillaiOctober 30, 2023 No comments

External Files List in Hyperlink Form.

The '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 forms 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 select 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()

Assuming 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 as Set Obj = Nothing releasing memory and resources.

This mechanism is especially useful when your class contains other objects—such as 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 Set Property 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 use 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 Subroutine from this class rather than placing the entire block of code directly under the Command Button event in Form. 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 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 file categories when browsing from the default path.

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 information 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 takes the files in hyperlink format, while the second column records the full file path for reference. Clicking the hyperlink will open the file in its native application (e.g., MS Word, Excel, others, if available in the system).

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 and 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 disk and remove its hyperlink from the list. Use this option only when you are sure to delete the actual file from your system, not just the link in Microsoft Access.

'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 named 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 named 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 Property Sheet's Other Tab.
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 named DT of the ClsDateTime Class Module. 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 of one Class Module from another, besides 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 Named 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 how it works now.
Try Calling the DateTime() Function from the Standard Module in a Test() Function.

Demo Database Download Link.

DirListing2K1.zip

Streamlining Form Module Code in Standalone Class Module.

New Custom-Made Report Wizard - Part 16

a.p.r. pillaiOctober 18, 2023 No comments

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.

The Report Wizard is designed with a TabControl containing two pages. On the first TabPage, a ListBox provides 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. To ensure that the first option is selected automatically, the Default Value property is set with the expression:


= WizList.Column(0,0)

This ListBox has 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 that 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 (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 Report Page Header section.

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 Report PageFooter Section.

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 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 creating the 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 is positioned between the two ListBox controls for 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 back 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

LEARN MS-ACCESS TIPS AND TRICKS

Streamlining Form Module VBA RGBColor Wizard

RGB Color Wizard.

Create your own RGB Color Palette for Form Design.

The RGB Color Wizard Image is given below.

The Wizard Controls.

The ScrollBar Controls.

The ColorWizard and Run-Time Data.

Sample Custom Property Management VBA Code.

The CWiz_TextBox Wrapper Class.

The CWiz_Label Wrapper Class.

Demo Database Download Link.

Streamlining Form Module Code in Standalone Class Module.

Streamlining Event Procedures 3D-Text Wizard

Example-1: Employee Name.

Example-2:Order Details Form View-2

The 3D Text Wizard Image is given below:

3D Text Creation Technique.

The 3D Text Shadow Positions.

3D Text Control Types.

The Form Module VBA Code.

The TWiz_Obj_Init Class Module Code is Listed Below.

The Command Button Wrapper Class Module.

Demo Database Download Link.

Streamlining Form Module Code in Standalone Class Module.

Streamlining Form VBA External Files List HyperLinks

External Files List in Hyperlink Form.

The 'FileDialog' Control

The Form Module VBA Code.

The FLst_CmdButton Class Module Code.

The cmdFileDialog() Subroutine.

The cmdDelLink Subroutine.

The cmdDelAll() Subroutine.

The cmdDelFile() Subroutine.

Caution:

The ButtonStatus()

Calling a Public Function from a Class Module.

Demo Database Download Link.

Streamlining Form Module Code in Standalone Class Module.

New Custom-Made Report Wizard - Part 16

Streamlining Custom-Made Reports Wizard Form Module VBA Code.

The SQL of the File Selection Query.

The RWizObject_Init Class.

Create_FilesList() Subroutine Code.

The Function that Creates the Report in Column Format.

The Tabular Type Report Creation Function.

The Page_Footer() Function Code.

The RWiz_CmdButton Class Module.

The RWiz_Combo Class Module Code

The RWiz_ListBox Class Module Code.

The RWiz_TabCtl Class Module Code.

Download the Demo Database from the Link given below.

Streamlining Form Module Code in Standalone Class Module.

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

Post Feed

Get new posts by email:

Search

USEFUL LINKS

Useful-Links

Popular Posts

About Me

Blog Archive

Labels

Report Abuse

Statcounter