Custom Report Wizard

Introduction.

After working with the Form Wizard, it’s only natural to consider designing a Report Wizard as well. The process of creating a Report is quite similar to that of designing a Form—the only notable difference is the Page Footer, which typically includes elements such as the page number and date.

If you’ve already followed the design steps outlined in the Custom-made Form Wizard tutorial, you don’t need to repeat them here. Refer to that earlier post to review the design process or download the completed example from there.

Designing Report Wizard.

Do the following few simple steps, and the Report-Wizard is ready:

1. Make a copy of the Form Wizard and rename it as ReportWizard.

2. Open the ReportWizard in Design View.

3. Change the List Box and Combo Box headings to read as Report Format and Select Table/Query for Report, respectively.

4. Change the word 'Form' to Report in the left-side labels.

5. Display the Code Module of the ReportWizard by selecting View ->Code (or Alt+F11).

6. Press Ctrl+A to select the entire code in the Form Module and press the Delete Key to delete the Code.

7. Copy and paste the code given below into the ReportWizard Form Module and save the Form:

   Report Wizard VBA Code

   Option Compare Database
   Option Explicit
   Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String
   Dim MaxSeq As Integer
   
   Private Sub cmdBack_Click()
      Me.Page1.Visible = True
      Me.Page1.SetFocus
      Me.Page2.Visible = False
   End Sub
   
   Private Sub cmdCancel_Click()
      DoCmd.Close acForm, Me.NAME
   End Sub
   
   Private Sub cmdCancel2_Click()
      DoCmd.Close acForm, Me.NAME
   End Sub
   
   Private Sub cmdForm_Click()
   If xtyp = 1 Then
      Columns
   Else
      Tabular
   End If
   DoCmd.Close acForm, Me.NAME
   
   cmdForm_Click_Exit:
   Exit Sub
   
   cmdForm_Click_Err:
   MsgBox Err.Description, , "cmdForm_Click"
   Resume cmdForm_Click_Exit
   End Sub
   
   Private Sub cmdNext_Click()
   Dim vizlist As ListBox, lcount As Integer, chkflag As Boolean
   Dim FildList As ListBox, strName As String, strRSource As String
   Dim cdb As Database, doc As Document
   Dim Tbl As TableDef, Qry As QueryDef, QryTyp As Integer
   Dim flag As Byte, FieldCount As Integer, j As Integer
   
   On Error GoTo cmdNext_Click_Err
   
   Set vizlist = Me.WizListlcount = 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(Me![FilesList]) = True Then
      MsgBox "Select a File from Table/Query List. ", vbOKOnly + vbExclamation, "cmdNext"
      Me.WizList.Selected(0) = True
   Else
       strFile = Me!FilesList
       Me.Page2.Visible = True
      Me.Page2.SetFocus
      Me.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 = Me.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
   
   Me.FldList.RowSource = strRSource
   End If
   
   cmdNext_Click_Exit:
   Exit Sub
   
   cmdNext_Click_Err:
   MsgBox Err & ": " & Err.Description, , "cmdNext_Click"
   Resume cmdNext_Click_Exit
   End Sub
   
   Private Sub FilesList_NotInList(NewData As String, Response As Integer)
     'Not in List
   End Sub
   
   Private Sub Form_Load()
   Dim strRSource As String, FList As ComboBox
   Dim cdb As Database, MaxTables As Integer, rst As Recordset
   Dim Tbl As TableDef, Qry As QueryDef, fld As Field
   Dim j As Integer, strSQL1 As String, rstcount As Integer
   Dim MaxSeq As Integer, mMax
   
   On Error Resume Next
   
   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; "
   
   mMax = 100
   DoCmd.Restore
   
   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
   
   Me.FilesList.RowSource = "WizQuery"Me.FilesList.Requery
   
   Form_Open_Exit:
   Exit Sub
   
   Form_Open_Err:
   MsgBox Err & ": " & Err.Description, , "Form_Open"
   Resume Form_Open_Exit
   End Sub
   
   Private Sub cmdLeft_Click()
      LeftAll 1
   End Sub
   
   Private Sub cmdLeftAll_Click()
      LeftAll 2
   End Sub
   
   Private Sub cmdright_Click()
       RightAll 1
   End Sub
   
   Private Sub cmdRightAll_Click()
       RightAll 2
   End Sub
   

   Create Left-side ListBox Items.

   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 = Me.FldListSet
    SelctList = Me.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
       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.RequeryEnd Select
   
   LeftAll_Exit:
   Exit Function
   
   LeftAll_Err:
   MsgBox Err.Description, , "LeftAll"
   Resume LeftAll_Exit
   
   End Function

   Create Right-side ListBox Items.

   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 = Me.FldListSet
    SelctList = Me.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
       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
   End Select
   
   RightAll_Exit:
   Exit Function
   
   RightAll_Err:
   MsgBox Err.Description, , "RightAll"
   Resume RightAll_Exit
   End Function
   

   Create a Report In Tabular Format.

   Public Function Tabular()
   Dim cdb As Database, FldList() As String, Ctrl As Control
   Dim Rpt As Report, lngTxtLeft As Long, lngTxtTop As Long, lngTxtHeight As Long
   Dim Rpttemp As Report, lngLblleft As Long, lngLblTop As Long, lngLblheight As Long
   Dim lngtxtwidth As Long, lnglblwidth As Long, FldCheck As Boolean
   Dim strTblQry As String, intflds As Integer, lstcount As Long
   Dim RptFields As ListBox, j As Integer, mMax
   Dim PgSection As Section, DetSection As Section
   
   'Create Report with Selected Fields
   
   On Error Resume Next
   
   Set RptFields = Me.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 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_ExitEnd Function
   

   Create a Report In Columns Format.

   Public Function Columns()
   Dim cdb As Database, FldList() As String, Ctrl As Control
   Dim Rpt As Report, lngTxtLeft As Long, lngTxtTop As Long, lngTxtHeight As Long
   Dim lngLblleft As Long, lngLblTop As Long, lngLblheight As Long
   Dim lngtxtwidth As Long, lnglblwidth As Long, FldCheck As Boolean
   Dim strTblQry As String, intflds As Integer, lstcount As Long
   Dim FrmFields As ListBox, j As Integer, mMax
   Dim HdSection As Section, DetSection As Section
   
   'Create Report with Selected Fields
   
   On Error Resume Next
   
   Set FrmFields = Me.SelList
   lstcount = FrmFields.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) = FrmFields.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 = "Verdana"
          .FontSize = 8
          .FontWeight = 700
          .ForeColor = DarkBlue
          .BorderColor = DarkBlue
          .NAME = FldList(j)
          .BackColor = RGB(255, 255, 255)
          .BorderStyle = 1
          .SpecialEffect = 0
          If (j / 9) = 1 Or (j / 9) = 2 Or (j / 9) = 3 Then
           lngTxtTop = (0.0417 * twips)
           lngTxtLeft = lngTxtLeft + (2.7084 * twips)
          Else
           lngTxtTop = lngTxtTop + .Height + (0.1 * twips)
          End If
       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
          If (j / 9) = 1 Or (j / 9) = 2 Or (j / 9) = 3 Then
           lngLblTop = (0.0417 * twips)
           lngLblleft = lngLblleft + (2.7083 * twips)
          Else
           lngLblTop = lngLblTop + .Height + (0.1 * twips)
          End If
       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
   
   DoCmd.OpenReport Rpt.NAME, acViewPreview
   
   Columns_Exit:
   Exit Function
   
   Columns_Err:
   MsgBox Err.Description, , "Columns"
   Resume Columns_Exit
   End Function
   

   Create the Report's Page-Footer Contents.

   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 PageNo 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 = "Verdana"
      .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 = "Verdana"
      .FontSize = 10
      .FontWeight = 700
      .TextAlign = 3
   End With
   
   Page_Footer_Exit:
   Exit Function
   
   Page_Footer_Err:
   MsgBox Err.Description, "Page_Footer"
   Resume Page_Footer_Exit
   End Function
   

   Try out the Report Wizard.

8. Open the ReportWizard in Normal View.

9. Select a Table or Query from the Combo Box.

10. Select the Tabular Wizard option from above.

11. Click OK to load the selected Table/Query Field List and open the List of Fields.

12. Select the Fields for the Report from the List Box.

13. Click Finish to create the Report.

After creating a report, it’s often necessary to adjust the controls in the Detail Section to better match the data type and field sizes. However, once these modifications are made, the Report Footer generated by the Wizard may no longer align properly with the new layout. Fortunately, we already have a solution for this issue, as described in the earlier article titled “Draw Page Border.” You can use either of the two programs provided there to redraw the Page Footer (after deleting the existing one) or resize it to fit the updated Detail Section design.

1. DrawPageFooter()
2. ReSizePageFooter()

There are other Reports related to Functions also presented there to make Report Designing tasks easier. You may take a look at them as well.

You can create beautiful 3D Headings on the Report or Form with Labels or Text Boxes (Text Box values can be drawn from data Fields). Take a look at the sample Report Headings created with a 3D-Text Creation Wizard:

Click to Enlarge

The following four posts are dedicated to 3D Text Styles, and you can download the 3D-Text Wizard from any of them:

1. Create 3D Headings on Forms
2. Border 2D Heading Text
3. Border 3D Heading
4. Shadow 3D Heading Style

After creating the 3D-Text, you can customize it by changing the Fonts, foreground color, and Styles like Bold, Italic, or Underline.

Download Custom Report Wizard

Download Demo ReportWizard.zip

• Wave-Shaped Reminder Ticker
• No Data and Report Error
• Lost Links of External Tables
• Link External Tables with VBA
• Source Connect Str Property and ODBC

Read More

Custom Made Form Wizard

Introduction.

Ever wondered how Form Wizards work? Let’s build one of our own and see it in action. You might ask, “Why bother creating one when MS Access already provides a Form Wizard?”,  and that’s a fair question. I thought the same for a while before deciding to design a custom wizard that better suits my needs.

There are two main reasons:

1. Although MS Access can quickly generate a ready-to-use form, it often requires additional modifications to improve its appearance — resizing, aligning, and rearranging fields and labels.

2. The default wizard creates text boxes of varying sizes and shapes depending on the data type, which means extra time spent adjusting them for a consistent and polished look.

Built-in Form Wizard Review

If you create a Tabular Form using the Employees table from the Northwind.mdb sample database, you’ll immediately see what I mean.

In Access 2000 and earlier, when a table or query contained too many fields, they couldn’t all fit within the standard 22 cm width of the form, resulting in an error. Later versions of Access addressed this by automatically shrinking and compressing controls to fit all the fields onto the form.

Our Own Customized Form Wizard

This is when I realized the need for a custom Wizard—one that could create a Tabular Form with uniformly sized fields (each about half an inch wide) so that more fields could fit neatly on the form. This design makes it easier to select, resize, and space out all fields at once, significantly reducing the time spent on manual adjustments. Any fields that require additional width can be resized individually afterward.

Using this approach helps save valuable design time and results in a cleaner, more consistent layout. Below is an image of a Tabular Form created using the Custom Form Wizard, which closely resembles a Datasheet view in appearance.

The Form Wizard features a simple and intuitive design, making it easy to create and use, apart from the VBA procedures that handle its functionality. You can download the Form Wizard from the link provided at the end of this post to explore its design, property settings, and VBA routines in detail.

An image of the Form Wizard in action is shown below. The Wizard allows you to create a basic form in either Column or Tabular format. You can also select the Table or Query for the form directly from a Combo Box.

The Design Task.

Form and Tab Control

1. Open a new Form.

2. Insert a Tab Control on the Detail Section of the Form.

   

3. Select the First Page of the Tab Control and display the Property Sheet (View -> Properties).

4. Change the Caption Property Value to Select Table. This description now appears on the First Page of the Tab Control.

   List Box and Property Settings

5. Create a List Box as shown on the design and position its child label on the top, and give the Caption value Form Type.

6. Create a Label on the left side of the List Box and enter the Caption Text as shown.

7. Click on the List Box and display the Property Sheet.

8. Change the following Property Values as shown below:

   • Name: wizlist
   • Row Source Type: Value List
   • Row Source: 1;"Form Wizard: Columns";2;"Form Wizard: Tabular"
   • Column Count: 2
   • Column Head: No
   • Column Width: 0";1"
   • Bound Column: 1

   Combo Box and Property Settings

9. Turn off the Wizard Tool in the Toolbox. Select the Combo Box Tool and draw a Combo Box as shown, below the List Box, and change the Property Values as given below:

   • Name: Files List.
   • Row Source Type: Table/Query
   • Row Source: WizQuery
   • Column Count: 1
   • Column Width: 1"
   • Bound Column: 1
   • List Width: 1"
   • Limit to List: Yes

10. Create a Label to the left of the Combo Box and change the Caption value as shown.

    Command Buttons

11. Create a Command Button below and change the Caption to OK.

12. Create a second Command Button to the right and change the Caption to Cancel.

13. Select the second Tab Control Page, and change its Caption property Value to Select Fields.

    

    List Boxes on Tab Page 2

14. Create a List Box for Field List and a Second List Box for Selected Fields side by side as shown in the above design.

15. Select the first List Box at the left, display the Property Sheet, and change the Property Values as shown below:

    • Name: FldList
    • Column Count: 1
    • Column Head: No
    • Column Widths: 2"
    • Bound Column: 1

16. Select the second List Box and change the Name Property to SelList and change other Properties to the same Values as given above.

    Command Buttons between List Boxes

17. Create four small Command Buttons between the List Boxes as shown on the design.

18. Change their Name property Values as cmdRight, cmdRightAll, cmdLeft, and cmdLeftAll from the first Command Button on the top of the fourth one at the bottom, respectively.

19. Change their Caption Property Values with >, >>, <, and << symbols as shown.

20. Create three Command Buttons below the List Boxes.

21. Change the Name Property Value of the left Command Button to cmdBack and the Caption Property Value to <.

22. Change the Name Property Value of the Command Button in the middle to cmdForm and the Caption Property Value to Finish.

23. Change the Name Property Value of the right side Command Button to cmdCancel2 and the Caption Property Value to Cancel.

24. Click to the right side of the second page of the Tab Control to select the Tab Control and display the Property Sheet.

25. Change the following Property Values:

    • Name: TabCtl0
    • Back Style: Transparent
    • Style: None

     After setting the last two properties of the Tab Control, it disappears, and nobody can tell that we have designed the whole Wizard on a Tab Control Object.

26. Save the Form (File -> Save) with the name FormWizard.

    One important step left to complete is copying and pasting the complete VBA Routines into the Form Module of the Form Wizard.

27. Display the Code Module of the Form (View -> Code), while the Form is still in design View, copy the entire Code given below and paste it into the Code Module of the Form, and save the Form.

    The Form Wizard VBA Code

    Option Compare Database
    Option Explicit
    Dim DarkBlue As Long, twips As Long, xtyp As Integer, strFile As String
    
    Private Sub cmdBack_Click()
       Me!FileList = Null
       Me.Page1.Visible = True
       Me.Page1.SetFocus
       Me.Page2.Visible = False
    End Sub
    
    Private Sub cmdCancel_Click()
        DoCmd.Close acForm, Me.NAME
    End Sub
    
    Private Sub cmdCancel2_Click()
       DoCmd.Close acForm, Me.NAME
    End Sub
    
    Private Sub cmdForm_Click()
    If xtyp = 1 Then
       Columns
    Else
       Tabular
    End If
    
    DoCmd.Close acForm, Me.NAME
    
    cmdForm_Click_Exit:
    Exit Sub
    
    cmdForm_Click_Err:
    MsgBox Err.Description, , "cmdForm_Click"
    Resume cmdForm_Click_Exit
    End Sub
    
    Private Sub cmdNext_Click()
    Dim vizlist As ListBox, lcount As Integer, chkflag As Boolean
    Dim FildList As ListBox, strName As String, strRSource As String
    Dim cdb As Database, doc As Document
    Dim Tbl As TableDef, Qry As QueryDef, QryTyp As Integer
    Dim flag As Byte, FieldCount As Integer, j As Integer
    
    On Error GoTo cmdNext_Click_Err
    
    Set vizlist = Me.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(Me![FilesList]) = True Then
       MsgBox "Select a File from Table/Query List. ", vbOKOnly + vbExclamation, "cmdNext"
       Me.WizList.Selected(0) = True
    Else
       strFile = Me!FilesList
       Me.Page2.Visible = True
       Me.Page2.SetFocus
       Me.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 = Me.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
    
    Me.FldList.RowSource = strRSource
    End If
    
    cmdNext_Click_Exit:
    Exit Sub
    
    cmdNext_Click_Err:
    MsgBox Err & ":" & Err.Description, , "cmdNext_Click"
    Resume cmdNext_Click_Exit
    End Sub
    
    Private Sub FilesList_NotInList(NewData As String, Response As Integer)
      'Add item
    End Sub
    
    Private Sub Form_Load()
    Dim strRSource As String, FList As ComboBox
    Dim cdb As Database, MaxTables As Integer, rst As Recordset
    Dim Tbl As TableDef, Qry As QueryDef
    Dim j As Integer, strSQL1 As String, rstcount As Integer
    
    On Error Resume Next
    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 = 8388608twips = 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
    
    Set FList = Me.FilesList
    Me.FilesList.RowSource = "WizQuery"
    Me.FilesList.Requery
    
    Form_Load_Exit:
    Exit Sub
    
    Form_Load_Err:
    MsgBox Err & ": " & Err.Description, , "Form_Load"
    Resume Form_Load_Exit
    End Sub
    
    Private Sub cmdLeft_Click()
       LeftAll 1
    End Sub
    
    Private Sub cmdLeftAll_Click()
       LeftAll 2
    End Sub
    
    Private Sub cmdright_Click()
        RightAll 1
    End Sub
    
    Private Sub cmdRightAll_Click()
        RightAll 2
    End Sub
    

    Create Left-side ListBox Items.

    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 = Me.FldList
    Set SelctList = Me.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
       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
    End Select
    
    LeftAll_Exit:
    Exit Function
    
    LeftAll_Err:
    MsgBox Err.Description, , "LeftAll"
    Resume LeftAll_Exit
    End Function

    Create Right-side ListBox Items.

    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 = Me.FldList
    Set SelctList = Me.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
        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
    End Select
    
    RightAll_Exit:
    Exit Function
    
    RightAll_Err:
    MsgBox Err.Description, , "RightAll"
    Resume RightAll_Exit
    End Function
    

    Create Tabular Type Form.

    Public Function Tabular()
    '-------------------------------------------------------------------'
    'Author : a.p.r. pillai
    'Date   : Sept-2000
    'URL    : www.msaccesstips.com
    'All Rights Reserved by www.msaccesstips.com
    '-------------------------------------------------------------------
    Dim cdb As Database, FldList() As String, Ctrl As Control
    Dim frm As Form, lngTxtLeft As Long, lngTxtTop As Long, lngTxtHeight As Long
    Dim lngLblleft As Long, lngLblTop As Long, lngLblheight As Long
    Dim lngtxtwidth As Long, lnglblwidth As Long, FldCheck As Boolean
    Dim strTblQry As String, intflds As Integer, lstcount As Long
    Dim FrmFields As ListBox, j As Integer
    Dim HdSection As Section, DetSection As Section
    
    'Create Form with Selected Fields
    
    On Error GoTo Tabular_Err
    
    Set FrmFields = Me.SelList
    lstcount = FrmFields.listcount
    
    If lstcount = 0 Then
       MsgBox "Fields Not Selected for the Form"
       Exit Function
    Else
       lstcount = lstcount - 1
    End If
    
    ReDim FldList(0 To lstcount) As String
    
    Set cdb = CurrentDb
    Set frm = CreateForm
    Application.RunCommand acCmdFormHdrFtr
    
    With frm
        .DefaultView = 1
        .ViewsAllowed = 0
        .DividingLines = False
        .Section(acFooter).Visible = True
        .Section(acHeader).DisplayWhen = 0
        .Section(acHeader).Height = 0.5 * 1440
        .Section(acFooter).Height = 0.1667 * 1440
    End With
    
    Set HdSection = frm.Section(acHeader)
        HdSection.Height = 0.6667 * twips
    
    Set DetSection = frm.Section(acDetail)
        DetSection.Height = 0.166 * twips
    
    For j = 0 To lstcount
      FldList(j) = FrmFields.ItemData(j)
    Next
    
    With frm
        .Caption = strFile
        .RecordSource = strFile
        lngtxtwidth = 0.5 * twips
        lngTxtLeft = 0.073 * twips
        lngTxtTop = 0
        lngTxtHeight = 0.166 * twips
    
        lnglblwidth = lngtxtwidth
        lngLblleft = lngTxtLeft
        lngLblTop = 0.5 * twips
        lngLblheight = lngTxtHeight
    End With
    
    For j = 0 To lstcount
       Set Ctrl = CreateControl(frm.NAME, acTextBox, acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
        With Ctrl
           .ControlSource = FldList(j)
           .FontName = "Verdana"
           .Width = (0.5 * twips)
           .FontSize = 8
           .ForeColor = 0
           .BorderColor = 12632256
           .NAME = FldList(j)
           .BackColor = 16777215
           .BorderStyle = 1
           .SpecialEffect = 0
           lngTxtLeft = lngTxtLeft + (0.5 * twips)
       End With
    
       Set Ctrl = CreateControl(frm.NAME, acLabel, acHeader, , FldList(j), lngLblleft, lngLblTop, lnglblwidth, lngLblheight)
        With Ctrl
           .Caption = FldList(j)
           .NAME = FldList(j) & " Label"
           .Width = (0.5 * twips)
           .ForeColor = DarkBlue
           .BorderColor = DarkBlue
           .BorderStyle = 1
           .FontWeight = 700 ' Bold
           lngLblleft = lngLblleft + (0.5 * twips)
        End With
    Next
    
    lnglblwidth = 4.5 * twips
    lngLblleft = 0.073 * twips
    lngLblTop = 0.0521 * twips
    lngLblheight = 0.323 * twips
    lnglblwidth = 4.5 * twips
     Set Ctrl = CreateControl(frm.NAME, acLabel, acHeader, , "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
    
    DoCmd.OpenForm frm.NAME, acNormal
    
    Tabular_Exit:
    Exit Function
    
    Tabular_Err:
    MsgBox Err.Description, , "Tabular"
    Resume Tabular_Exit
    End Function
    

    Create Form in Columns Format

    Public Function Columns()
    '-------------------------------------------------------------------
    'Author : a.p.r. pillai
    'Date   : Sept-2000
    'URL    : www.msaccesstips.com
    'All Rights Reserved by www.msaccesstips.com
    '-------------------------------------------------------------------
    Dim cdb As Database, FldList() As String, Ctrl As Control
    Dim frm As Form, lngTxtLeft As Long, lngTxtTop As Long, lngTxtHeight As Long
    Dim lngLblleft As Long, lngLblTop As Long, lngLblheight As Long
    Dim lngtxtwidth As Long, lnglblwidth As Long, FldCheck As Boolean
    Dim strTblQry As String, intflds As Integer, lstcount As Long
    Dim FrmFields As ListBox, j As Integer
    Dim HdSection As Section, DetSection As Section
    
    ''Create Form with Selected Fields
    
    On Error GoTo Columns_Err
    
    Set FrmFields = Me.SelList
    lstcount = FrmFields.listcount
    
    If lstcount = 0 Then
       MsgOK "Fields Not Selected for Form", "FormWizard"
       Exit Function
    Else
       lstcount = lstcount - 1
    End If
    
    ReDim FldList(0 To lstcount) As String
    
    Set cdb = CurrentDb
    Set frm = CreateForm
    Application.RunCommand acCmdFormHdrFtr
    With frm
        .DefaultView = 0
        .ViewsAllowed = 0
        .DividingLines = False
        .Section(acFooter).Visible = True
        .Section(acHeader).DisplayWhen = 0
        .Section(acHeader).Height = 0.5 * 1440
        .Section(acFooter).Height = 0.1667 * 1440
    End With
    
    Set HdSection = frm.Section(acHeader)
        HdSection.Height = 0.6667 * twips
    
    Set DetSection = frm.Section(acDetail)
        DetSection.Height = 0.166 * twips
    
    For j = 0 To lstcount
      FldList(j) = FrmFields.ItemData(j)
    Next
    
    With frm
        .Caption = strFile
        .RecordSource = strFile
        lngtxtwidth = 1 * twips
        lngTxtLeft = 1.1 * twips
        lngTxtTop = 0
        lngTxtHeight = 0.166 * twips
    
        lnglblwidth = lngtxtwidth
        lngLblleft = 0.073 * twips
        lngLblTop = 0 '0.5 * twips
        lngLblheight = lngTxtHeight
    End With
    
    For j = 0 To lstcount
    
       Set Ctrl = CreateControl(frm.NAME, acTextBox, acDetail, , FldList(j), lngTxtLeft, lngTxtTop, lngtxtwidth, lngTxtHeight)
        With Ctrl
           .ControlSource = FldList(j)
           .FontName = "Verdana"
           .FontSize = 8
           .ForeColor = DarkBlue
           .BorderColor = DarkBlue
           .NAME = FldList(j)
           .BackColor = RGB(255, 255, 255)
           .ForeColor = 0
           .BorderColor = 9868950
           .BorderStyle = 1
           .SpecialEffect = 2
           If (j / 9) = 1 Or (j / 9) = 2 Or (j / 9) = 3 Then
            lngTxtTop = 0
            lngTxtLeft = lngTxtLeft + (2.7084 * twips)
           Else
            lngTxtTop = lngTxtTop + .Height + (0.1 * twips)
           End If
        End With
    
       Set Ctrl = CreateControl(frm.NAME, acLabel, acDetail, FldList(j), FldList(j), lngLblleft, lngLblTop, lnglblwidth, lngLblheight)
       With Ctrl
           .Caption = FldList(j)
           .NAME = FldList(j) & " Label"
           .Width = twips
           .ForeColor = 0
           .BorderColor = 0
           .BorderColor = 0
           .BorderStyle = 0
           .FontWeight = 400 ' Normal 700 Bold
           If (j / 9) = 1 Or (j / 9) = 2 Or (j / 9) = 3 Then
            lngLblTop = 0
            lngLblleft = lngLblleft + (2.7083 * twips)
           Else
            lngLblTop = lngLblTop + .Height + (0.1 * 1440)
           End If
        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 = CreateControl(frm.NAME, acLabel, acHeader, , "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 = 18
            .FontWeight = 700 ' Bold
            .FontItalic = True
            .FontUnderline = True
     End With
    
    DoCmd.OpenForm frm.NAME, acNormal
    
    Columns_Exit:
    Exit Function
    
    Columns_Err:
    MsgBox Err.Description, , "Columns"
    Resume Columns_Exit
    End Function
    

    Note: Ensure that the Name property values of all objects are correctly assigned to avoid runtime errors. If any control does not work as expected, verify that its Name property matches the reference used in the VBA routines and that the On Click property is set to [Event Procedure]. When a control’s name matches its reference in the VBA code, Access will automatically insert the [Event Procedure] value for the event.

28. Open the Form Wizard in Normal View. Select one of the Form Design type Column or Tabular and select a Table or Query from the Combo Box below, and click OK. The List Box will appear with Field Names in the next step.

29. You can select one or more data fields of your choice and click the button with the > label to move the selected fields to the right side List Box. You can select all the Fields from the List by clicking on the command button with the >> label.

30. If you have second thoughts, you can remove the fields from the selected list the same way you selected from the first List Box, using the < and << labeled Command Buttons.

31. When you are ready to create the Form, click on the Finish Command Button.

The Form will be created and will open in Normal View. Save the Form and change it to the design view for modifications.

Download the Demo Database:

Download Demo FormWizard.zip

• Wave-Shaped Reminder Ticker
• No Data and Report Error
• Lost Links of External Tables
• Link External Tables with VBA
• Source Connect Str Property and ODBC

Read More

Rounding Function MRound of Excel

Introduction.

Normally, numbers are rounded in calculations when the fractional part is 0.5 or more, moving up to the next whole number, or truncated otherwise. However, there are situations where the fractional part itself needs to be rounded to a specific precision level — such as during monetary disbursements like wages.

For example, in currency handling, if a value ends in 15 cents or 30 cents, it may need to be rounded to 25 cents and 50 cents, respectively, to ensure the correct distribution of coin denominations. Suppose you have only 50-cent coins available — in that case, any amount of 25 cents or more should be rounded up to 50 cents, and amounts below 25 cents should be rounded down to zero.

To achieve this, we need a function that accepts both a numeric value and a precision level, calculates the nearest multiple of that precision, and rounds up when the remainder equals or exceeds half of the precision value. This precision value doesn’t have to be fractional; it can be any numeric increment.

In MS Access, the built-in Round() function only rounds numbers to a specified number of decimal places or to the nearest integer, following standard rounding rules. MS Excel, however, provides a Worksheet Function MRound() that can perform such precision-based rounding. Unfortunately, no equivalent function exists in MS Access — and we can’t rely on Excel when this functionality is needed directly within Access.

The MRound Function

We will write an MRound() Function in Access with the same name.

So here it is:

Public Function MRound(ByVal Number As Double, ByVal Precision As Double) As Double
Dim Y As Double

On Error GoTo MRound_Err

   Y = Int(Number / Precision) * Precision
   MRound = IIf(((Number - Y) / Precision * 100 + 0.1) >= 50, Y + Precision, Y)

MRound_Exit:
Exit Function

MRound_Err:
MsgBox Err.Description, , "MRound()"
MRound = 0
Resume MRound_Exit
End Function

Save the Function and do Test Runs.

Copy and paste the above Code into a Global Module of your Database and save the Module.

Open the Debug Window (Ctrl+G) to try it out directly.

Sample Runs:

? Mround(123.3,0.2)

Result: 123.4

? Mround(123.24,0.5)

Result: 123

? Mround(123.25,0.5)

Result: 123.5

? Mround(123.74,0.5)

Result: 123.5

? Mround(123.75,0.5)

Result: 124

? Mround(10,3)

Result: 9

? Mround(11,3)

Result: 12

Add to your Function Library

If you would like to share this Function across your Other MS-Access Databases, then create a Library Database with the Function in it and set a Reference to the Library Database through Tools -> References in the VBA Window.

Earlier Post Link References:

1. Roundup Excel Function in MS Access
2. Proper Excel Function in Microsoft Access
3. Appending Data from Excel to Access
4. Writing Excel Data Directly into Access
5. Printing MS-Access Report from Excel
6. Copy-Paste Data From Excel to Access 2007
7. Microsoft Excel-Power in MS-Access
8. Rounding Function MROUND of Excel
9. MS-Access Live Data in Excel
10. Access Live Data in Excel- 2
11. Opening an Excel Database Directly
12. Create Excel, Word Files from Access

Read More

Custom Calculator and Eval Function

Introduction.

When we think of a calculator, the image that usually comes to mind is the traditional type with buttons labeled 0–9 and the standard arithmetic operators. Windows already includes such a calculator under Accessories, which can even be switched to Scientific mode — so there’s no need to recreate that in MS Access.

Instead, we’re going to design a different kind of calculator — one that can evaluate defined expressions consisting of data field names, constants, arithmetic operators, and parentheses (to control the order of operations). This calculator will allow you to input an expression, have Access evaluate it, and display the result instantly.

There’s no need for a complex interface. All we require is:

• A TextBox to enter the expression,

• A Command Button to trigger the evaluation, and

• A few lines of VBA code to process the calculation.

The result can be displayed either in a MsgBox or in another TextBox on the form.

Before we begin building the calculator, let’s look at one of Access’s most powerful yet underused built-in functions — the EVAL() function. This function will serve as the core engine of our custom calculator. With EVAL(), you don’t need to worry about following mathematical rules manually — such as evaluating parentheses first, then exponentiation, followed by multiplication and division (from left to right), and finally addition and subtraction. Simply pass the expression as a string to the EVAL() function, and it will return the correctly computed result.

EVAL() Function Usage

Try a few examples quickly to get a feel of it? Open the VBA Module Window (Alt+F11) and open the Debug Window (Ctrl+G). Type the following expressions in the Debug Window and press the Enter Key:

? EVAL("2+3*4/2")

Result: 8

? EVAL("(2+3)*4/2")

Result: 10

? EVAL("log(SQR(625))/log(10)")

Result: 1.39794000867204

? Eval("10^" & "Eval('log(Sqr(625))/log(10)')")

Result: 25

? EVAL("Datediff('yyyy',Forms!Employees!BirthDate,date())")

Result: 45 (the Employees Form must be open)

EVAL() the Expression Parser

From the above examples, we can see that you can write expressions in a TextBox using built-in functions, data field references, and numeric constants. The Eval() function then parses the expression and returns the result. This gives the user the flexibility to define and evaluate custom expressions dynamically, incorporating live data from form fields into their calculations.

Tip: The Eval() function can do much more than just evaluate formulas. It can also run other functions, trigger the Click event of a command button, or execute a macro programmatically. For additional details and examples of how Eval() can be used, open the Microsoft Access Help window in the VBA editor and search for “Eval Function.”

The sample Demo Project.

I have created a sample database (available for download at the bottom of this post) designed for an auto dealership that offers credit facilities to customers at nominal interest rates of 6%, 7%, or 8%, repayable in 24, 36, or 60 installments, respectively. The salesperson is responsible for determining the most suitable repayment plan for each customer, including the percentage of down payment, installment schedule, and applicable interest rate.

To encourage sales, the salesperson is also authorized to offer customers a discount of up to 20% on the Maximum Retail Price (MRP), based on negotiation and customer eligibility.

An image of the Form he uses to run these calculations is given below:

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

This is a stand-alone form (which can optionally be linked to a table) containing unbound text boxes. Each text box is labeled with its corresponding name displayed to the left. When writing expressions, it is essential to properly qualify the control names, for example:
Forms!CustomCalculator!Balance

Note that shorthand references such as Me!Balance are not accepted in this context. This can make it somewhat cumbersome to build expressions, especially when multiple field names are involved in a formula.

The VBA Code

We have created a small VBA routine that recognizes text box names enclosed in square brackets [ ], retrieves their corresponding values, and substitutes them into the expression before passing it to the Eval() function.

For easier expression entry, a combo box containing arithmetic operators and text box names (in square brackets) is provided on the form. The colored display control below shows, for informational purposes, the expression after the text box references have been replaced with their actual values. just before it is submitted to the Eval() function.

When the Calculate Command Button is clicked, the result of the calculation is displayed in the Text Box with a dark background and the label Result. The VBA Code is given below:

Private Sub cmdCalc_Click()
'-----------------------------------------------------------
'Author : a.p.r. pillai
'Date    : November, 2008
'URL     : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'-----------------------------------------------------------
Dim str As String, loc1 As Integer, chk As Integer
Dim strout As String, loc2 As Integer, loc3 As Integer
Dim strin As String
Const sqrleft As String = "["
Const sqrright As String = "] "

On Error GoTo cmdCalc_Click_Err

'change the reference if different
str = Me![Expression]

loc1 = InStr(1, str, sqrleft)
If loc1 > 0 Then
   strin = Left(str, loc1 - 1)
   strout = Left(str, loc1 - 1)
   loc2 = InStr(loc1, str, sqrright)
End If
Do While loc2 > 0
   strin = strin & Mid(str, loc1, (loc2 - loc1) + 1)
   strout = strout & Me(Mid(str, loc1, (loc2 - loc1) + 1))
   loc1 = InStr(loc2 + 1, str, sqrleft)
   If loc1 > 0 Then
     loc2 = InStr(loc1, str, sqrright)
      If loc2 = 0 Then
         MsgBox "Errors in Expression, correct and retry. "
         Exit Sub
      Else
         strout = strout & Mid(str, Len(strin) + 1, loc1 - (Len(strin) + 1))
         strin = strin & Mid(str, Len(strin) + 1, loc1 - (Len(strin) + 1))
      End If
   Else
     loc3 = loc2
     loc2 = 0
   End If
Loop

If Len(str) > loc3 Then
   strout = strout & Mid(str, loc3 + 1)
End If

'this line can be removed if not required
Me![parsed] = strout

'change the reference, if different
Me![result] = Eval(strout)

cmdCalc_Click_Exit:
Exit Sub

cmdCalc_Click_Err:
MsgBox Err.Description, , "cmdCalc_Click()"
Resume cmdCalc_Click_Exit
End Sub

Private Sub cmdReset_Click()
Me![Expression] = Null
Me![parsed] = Null
End Sub

Note: There is no validation check included in the Code to detect misspelled names or unbalanced parentheses, etc. These shortcomings will automatically generate an error when the EVAL() function executes. The user will be able to review the expression, make corrections, and re-try.

Download

You can implement this program on any Form with a small change in str = Me![Expression] and Me![result] = Eval(strout) lines in the Code, if different names are used. Customize the Combo Box contents based on your input Field Names.

CustomCalc.zip

• Lost Links of External Tables
• Link External Tables with VBA
• Source Connect Str Property and ODBC
• Access Live Data in Excel-2
• MS-Access Live Data in Excel

Read More

Data Editing And Security Issues

Introduction.

Data entry and editing are among the most crucial activities for keeping a database accurate and up to date. These steps ensure that the information remains reliable and ready for generating meaningful reports and analysis. To make data entry easier and more efficient for users, it is good practice to include combo boxes, check boxes, and calculated fields—for example, automatically determining a Payment Due Date as 30 days after the Material Delivery Date.

Another key consideration is data security. Here, the focus is not on preventing unauthorized external access—MS Access already provides robust built-in security features for that—but rather on protecting the data from accidental modifications or deletions by authorized users during routine operations.

For example, suppose our Employee database includes a Memo field that stores detailed information about each employee’s educational background and prior work experience. Normally, when the cursor (insertion point) moves into a field, the entire content of that field becomes highlighted and selected. At this stage, if the user’s attention is momentarily diverted and a key is pressed accidentally, the entire content of the field may be deleted. If the user does not immediately notice this or forgets to restore the data using Ctrl + Z (Edit → Undo Typing), the information could be lost permanently.

Protecting from unintended Changes.

We will focus on this specific behavior of the cursor and explore how to provide a level of protection against such inadvertent data loss. The way the cursor behaves when entering a field is determined by the settings found under the Keyboard tab of the Options dialog box (available from the Tools menu). Under the Behavior Entering Field section, you will find three different options, as shown in the image below:

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

The first option, Select Entire Field, is the default setting. However, choosing one of the other two options is generally more advisable to prevent the kind of data loss we are focusing on. Of the remaining two, my preferred choice is Go to End of Field. The reason is simple—when this option is selected, even if you accidentally press the Delete key or any other key, the insertion point is positioned at the end of the field content, and the existing information remains safe.

Since this is a global setting in Microsoft Access, any manual changes you make here will affect all forms in every database opened on your machine. Conversely, a database you design on your system will not carry these settings when opened on another computer in a multi-user environment. Moreover, you may not want this behavior applied to every form in your database.

The best approach, therefore, is to enable this feature programmatically through a VBA routine and restore the default settings when leaving that particular form. In a shared network environment, users may have different default settings for the “Behavior Entering Field” option on their own machines, so it’s important not to change these preferences permanently.

Following is the numeric value of each Behavior Entering Field Option setting:

Behavior | Description | Option Values.

1. Select Entire Field - 0
2. Go to Start of Field - 1
3. Go to End of Field - 2

When opening a form that requires this modified cursor behavior, we will follow specific steps to enable it during the form’s initialization. Then, when the form is closed, we will restore the default settings to ensure that the global behavior of Access remains unchanged.

1. Save the current default setting of Behavior Entering Field before it is changed.

2. Change the setting to Go to the end of Field behavior for the current session of the Form.

3. Reset it back to the saved value in Step 1 above, before closing the Form.

We can achieve this with the following Event Procedures in the Form Module:

Option Compare Database
Dim DefaultBehavior As Integer

Private Sub Form_Load()
    DefaultBehavior = Application.GetOption("Behavior Entering Field")
    Application.SetOption "Behavior Entering Field", 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Application.SetOption "Behavior Entering Field", DefaultBehavior
End Sub

Copy and paste the above Code into the Form's Code Module and save the Form. The Dim DefaultBehavior As Integer statement must be placed in the Global area of the Module as shown above.

Try out the New Setting

Open the Form in normal View and try moving the cursor from one field to the other by tapping the Tab Key or the Enter Key. The insertion point will position at the end of the field contents.

• Link External Tables with VBA
• Source Connect Str Property and ODBC
• Access Live Data in Excel-2
• MS-Access Live Data in Excel
• Database Connection String Properties
• Opening an Excel Database Directly

Read More

Event Trapping Summary On Datasheet

Introduction.

How do we execute the Event like LostFocus() and GotFocus() procedures in the Datasheet view?

How to display the Summation of numeric values on the Datasheet view?

For answers to both questions, we need a sample Table and a Datasheet Form.

Import the following tables from the Northwind.mdb sample database C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb.

• Order_Details
• Products

We also need the Products table because it is referenced by the ProductID field in the Order_Detail table through a Combo Box. Without the Products table, the ProductID field in the Order_Detail table would remain empty, which would break the data relationship.

Design a Datasheet Form

1. To create a Datasheet Form, click on the Order_Detail Table, select Form from the Insert Menu, and select Autoform: Datasheet from the displayed list of options in the Formwizard.

   A Datasheet form will be created and will open the Table contents in Datasheet View.

2. Select the Save As... option from the File Menu and give the name Order Details for the Form. The Datasheet Form will be saved, but it will not be closed.

3. Select Design View from the View Menu to change the Form to Design View mode.

The Form in Design View should look like the image shown below, although the appearance may vary slightly depending on your version of Microsoft Access.

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

Doesn't matter how the Fields are arranged on the Form, whether in Row or Column Format, the data will always be displayed in Datasheet format. The placement of Fields will not affect the way the data is displayed on the Datasheet, but the Tab Order does.

The Tab Order of Controls

Let us find out how the Field's Tab Order influences the Datasheet View.

1. Change the Form into Datasheet View (View -> Datasheet View) and check the order of fields appearing in there.

2. Change the View into Design mode again and re-arrange the ProductID and UnitPrice fields by switching their places.

3. Change the View back to Datasheet and inspect the data field order.

   There will not be any change in the Order of Fields displayed from the previous View. If you move the Cursor using the Tab Key, then it moves in the same order as the fields' placement, as you have seen earlier before switching the fields.

4. Change the Form back to Design View again.

5. Select Tab Order... from the View menu. Click on the left border of the UnitPrice field on the Tab Order Control, click and drag it up, and place it below the OrderID field.

   Tip: You can click on the Auto Order Command Button to re-arrange the Tab Order according to the field placements on the Form.

6. Open the Form in normal view now and check the change of field placements.

The Unbound Text Box

We will add one Unbound Text Box on the Form to calculate the Extended Price after adjusting the discounts of each item.

1. Open the form in design view if you have closed it.

2. Drag the Form Footer Section down to get more room to place another Text Box below, or you can place it to the right of the Discount Field, too.

3. Create a Text Box and write the formula =(1-[Discount])*[UnitPrice]*[Quantity] in it.

4. While the Text Box is still in the selected state, display the Property Sheet (View -> Properties).

5. Change the Format Property value to Currency format. Change the Name Property value to Extended Price.

6. Open the Form in normal view and check the newly added Text control heading at the top. It will be something like Text10:.

   In Datasheet View of Forms, MS-Access uses the Caption of the Child Labels attached to the text boxes as Field headings. We have changed the Name Property of the Text Box to Extended Price, but that is ignored here.

7. Now, change the Form into the design view and delete the Child Label attached to the Extended Price Text Box.

8. Change to Datasheet view again and check the field name appearing at the top; it will be Extended Price now.

Datasheet Event Procedure

1. To try an Event Procedure on the Datasheet view, copy and paste the following VBA Code into the Form's Code Module (View -> Code to display the Code Module of the Form) and save the Form with the Code.

   Private Sub UnitPrice_LostFocus()
   Dim newUnitPrice As Double, msg As String
   Dim button As Integer
   
   button = vbQuestion + vbYesNo + vbDefaultButton2
   
   If Me![UnitPrice] = Me![UnitPrice].OldValue Then
      msg = "Replace UnitPrice: " & Me![UnitPrice].OldValue & vbCr & vbCr
      msg = msg & "with New Value: " & Me![UnitPrice]
   
      If MsgBox(msg, button, "UnitPrice_LostFocus()") = vbNo Then
           Me![UnitPrice] = Me![UnitPrice].OldValue
       End If
   End If
   
   End Sub
   

   We will attempt to trap the change in the UnitPrice field and will ask the user to confirm whether to retain the change or cancel it.

2. Open the Form in the datasheet view and make some changes in the UnitPrice Field and leave the Field by pressing the Tab Key or Enter key.

A Message Box will appear asking for permission to retain the change or to cancel it.

Datasheets can be programmed with Event Procedures (Field level or Form level) for validation checks and display of information.

Displaying of Summary Information

Method-1

We will attempt to answer the second question we have raised on top of this page.

1. Open the Order_Details Form in Design View.

2. Drag the Form Footer Section down to get enough room to place two TextBoxes. Create two TextBoxes in the Form Footer Section.

3. Write the formula =Sum([Quantity]) in the first Text Box.

4. Display the Property Sheet of the Text Box and change the Name Property value to TOTALQTY.

5. Write the formula =Sum((1-[Discount])*[UnitPrice]*[Quantity]) in the second Text Box.

6. Change the Name Property Value to TOTALVALUE.

When we open the Order_Details Form in Datasheet View, it will calculate the Summary Values in TOTALQTY and TOTALVALUE TextBoxes on the Footer of the Form, but we must do something to display them.

The first idea that usually comes to mind is to use a MsgBox to display the results within a Form’s event procedure. However, since the underlying records may change over time, these updates should be reflected in the summary values. Therefore, we must ensure that the results can be refreshed to display the latest data before showing them again.

We will implement this method before we settle on a better one.

1. Copy and paste the following Code into the Form's Code Module and save the Form:

   Private Sub Form_DblClick(Cancel As Integer)    
   Dim msg As String
        Me.Refresh
       msg = "Total Quantity = " & Me![TOTALQTY] & vbCr & vbCr
       msg = msg & " | Total Value = " & Format(Me![TOTALVALUE], "Currency")
   
        MsgBox msg
   End Sub
   

2. Open the Form in Datasheet View.

3. Double-click on the Record Selector at the left border of the Form.

   A Message Box pops up with the Summary Values from the TextBoxes in the Form Footer Section.

4. Make some changes to the Quantity and UnitPrice fields to try Step 3 again. The values change will appear in the Message Box.

5. You can filter the Data on ProductID or on OrderID by right-clicking on these fields and selecting Filter by Selection or other Options available on the displayed Shortcut Menu, and by executing Step 3 to get the Summary of selected records.

Method-2

After trying out the above method, your response may be something like "Yah.. it serves the purpose, but it doesn't give the impression of a sophisticated method. After all, it takes so many clicks and pop-up Message Boxes". I agree with you, too.

With a small change to the above Code, we can make the results the way you like them, I hope!

1. Open the Form in Design View.

2. Display the Property Sheet (View -> Properties).

3. Select the Mouse Move Property and select Event Procedure from the drop-down control.

4. Click on the build (...) button on the right side of the Property to open the Form's Code Module.

5. Cut the Code lines from within the Form_DblClick() Event Procedure:

   Private Sub Form_DblClick(Cancel As Integer)
   
   End Sub
   

   Leave the above lines alone and paste the Code into the Form_MouseMove() Event Procedure.

6. Change the line that reads:

   MsgBox msg

   to

   Me.Caption = msg

   After the change, the Code will look like the following:

   Private Sub Form_DblClick(Cancel As Integer)
   
   End Sub
   
   Private Sub Form_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim msg As String
       Me.Refresh
       msg = "Total Quantity = " & Me![TOTALQTY] & vbCr & vbCr
       msg = msg & " | Total Value = " & Format(Me![TOTALVALUE], "Currency")
       Me.Caption = msg
   End Sub
   

7. Open the Form in Datasheet View and move the Mouse over into the data area by crossing the Field Headings or the Record Selectors on the left side.

8. Check the Title Area of the Datasheet View, and you will find the Summary information is displayed there. A sample image is given below:

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

Now try changing the field values or filtering the data and moving the Mouse over the Field Headings or Record Selectors at the left to get the result on the Title Bar instantly. No Message Boxes or Double-Clicks, and what do you say about that?

• Source Connect Str Property and ODBC
• Access Live Data in Excel-2
• MS-Access Live Data in Excel
• Database Connection String Properties
• Opening an Excel Database Directly

Read More