Streamlining Custom Made Reports Wizard Form Module VBA Code.
Hope you like the Custom Form Wizard of last week, which organized its VBA Code in standalone Class Modules. You can reach the Code and review and study them without interfering with the Form Design and Form Module.
The custom-made Form Wizard and the Report Wizard Forms have no difference in their User Interface Design. The Report Wizard was also published earlier, way back in December 2008 under Access 2003. Now, the Report Wizard Form Module VBA Codes run from the standalone Class Module to create the Reports.
The Report Wizard is designed using a TabControl with two Pages. The first TabPage displays the Wizard Type Options in a ListBox and the Table/Query list in a ComboBox Control.
1. Report in Column Format.
2. Report in Tabular Format.
The above two Options are inserted as Value List in the RowSource Property of the ListBox. The Default Value Property is set with the expression: = WizList.Column(0,0) to select the first item by default.
The ComboBox Control displays the list of Tables and Select-Queries filtered from the System Table MSysObjects. The ComboBox's Default Value Property is also set with the expression: =FilesList.Column(0,0) to select the first file as 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 area of the Form Module. In the Form_Load() Event Procedure the Form Object reference is passed to the RWizObject_Init Class Module Property Procedure through 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.
The major part of the Code lines in both these Wizards are Variable declarations for defining the TextBox and for its Child Label Controls, and for their dimension values, other values like Font, Font Size, ForeColor, and other attribute values settings also come after the creation of these controls.
The statement Set Ctrl = CreateReportControl():
Set Ctrl = CreateReportControl(Rpt.Name, acTextBox, _ acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
have several Parameters which need their values predefined before calling the CreateReportControl() Function. The first Parameter is the Report Name, next is the type of control (here the TextBox), where to create the Control (in the Detail Section), next is the Parent Parameter if it is a SubReport (here omitted), the fifth parameter is the Field Name and the next four parameters are the control's dimension values.
The Font and Color attributes of the control are set after its creation. Similarly, the TextBox control's Child Label Control is created next in the Page-Header Section of the Report.
In the above Column-Format Report, the Label Control is created in the Detail Section and to the left side of each TextBox Control. The TextBox is created after leaving enough space for the child-label control on the left side.
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
There are several Command Buttons on both Pages of the TabControl and all their Event Subroutines are run in the RWiz_CmdButton Wrapper Class. There is one Command Button on the second Page with the caption Finish that runs the Report Wizard's Functions. All the Wizard Functions are placed in the WizObject_Init Class Module. For that reason, a separate Command Button Control Instance is defined for the cmdFinish in the WizObject_Init Class Module. The Command Button name on the Form is cmdReport with the caption Finish. The cmdFinish Instance created in the Class Module is not added to the Collection Object after enabling the OnClick Event.
The Click Event Subroutine of this Command Button is written in the WizObject_Init Class Module so that the Report Wizard Functions can be called from this Module directly.
At the beginning of the Class_Init() Subroutine, the Create_FilesList() Function is called to create the ComboBox's source list of Tables and Select Queries, followed by the creation of ListBoxes, Command Buttons instances, enabling their Events and adding them to the Collection Object.
The cmdReport Click Event calls the Report Creation Function. The Column Type Report is not likely to be used, but it is useful for 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
The Set of four Command Buttons, between the List Boxes on the second Page of the Wizard Form, controls the Field select/unselect operations. The first button moves the selected field from the first list to the second Listbox for the Report only one field at a time. The second Command Button with two greater-than symbols moves all the fields in the first ListBox to the 2nd ListBox.
The next Command Button removes the item selected from the second ListBox and places it back in the first ListBox. The fourth Command Button Click will remove all the List items selected earlier in the second ListBox for Report and move them all together back in the first ListBox.
The Back Command Button Click will empty the second ListBox and go back to the Report Wizard's first Page.
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 the 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
This Wrapper Class Module has the TabPage_Change() Event included for completeness, but not used for any purposes.
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 Elevan
- 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.