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:
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:
Report Wizard Page2 Image:
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:
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:
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.
Streamlining Form Module Code in Standalone Class Module.
- Reusing Form Module VBA Code for New Projects.
- Streamlining Form Module Code - Part Two.
- Streamlining Form Module Code - Part Three
- Streamlining Form Module Code - Part Four
- Streamlining Form Module Code - Part Five
- Streamlining Form Module Code - Part Six
- Streamlining Form Module Code - Part Seven
- Streamlining Form Module Code - Part Eight
- Streamlining Form Module Code - Part Nine
- Streamlining Form Module Code - Part Ten
- Streamlining Form Module Code - Part Eleven
- Streamlining Report Module Code in Class Module
- Streamlining Module Code Report Line Hiding-13.
- Streamlining Form Module Code Part-14.
- Streamlining Custom Made Form Wizard-15.
- Streamlining VBA Custom Made Report Wizard-16.
- Streamlining VBA External Files List in Hyperlinks-17
- Streamlining Events VBA 3D Text Wizard-18
- Streamlining Events VBA RGB Color Wizard-19
- Streamlining Events Numbers to Words-20
- Access Users Group(Europe) Presentation-21
- The Event Firing Mechanism of MS Access-22
- One TextBox and Three Wrapper Class Instances-23
- Streamlining Code Synchronized Floating Popup Form-24
- Streamlining Code Compacting/Repair Database-25
- Streamlining Code Remainder Popup Form-26
- Streamlining Code Editing Data in Zoom-in Control-27
- Streamlining Code Filter By Character and Sort-28
- Table Query Records in Collection Object-29
- Class for All Data Entry Editing Forms-30
- Wrapper Class Module Creation Wizard-31
- wrapper-class-template-wizard-v2












No comments:
Post a Comment
Comments subject to moderation before publishing.