Custom Made Form Wizard ~ LEARN MS-ACCESS TIPS AND TRICKS

Introduction.

Want to know how Form Wizards work? We will build one of our own and try it out. Perhaps, you may ask why we should do this when MS-Access already has a Form Wizard. Very true and I thought on those lines for some time, before I decided to give it a try and create the one that I need. Mainly for two reasons:

Even though MS-Access creates a Form on ready to use basis, most of the time we must modify this to make it a better-looking one. Needs more time for resizing, shaping, and arranging the fields and labels.
It creates Text Boxes of various sizes and shapes depending on the data type and needs more time to shape it up.

Built-in Form Wizard Review

If you create a Tabular Form using Employee Table from the Northwind.mdb sample database, you will know what I am talking about.

Up to Access2000, when the Table or Query has more fields, then all of them cannot be placed on the 22cm width of the Form and ends up in error. Later Versions squeeze the controls to accommodate all the fields on the Form.

Our Own Customized Form Wizard

This is where I thought I need a Wizard to create a Tabular Form with equal-sized fields (all fields with half an inch in size) so that we can accommodate more fields on the Form. It will be easier to select all of the fields together, re-size quickly and space them out in one step. Fields that need more width can be re-sized on a case-to-case basis later. This way we can save some design time. A Tabular Form image created by the Custom Form Wizard (it looks almost like a Datasheet) is given below:

The Form Wizard has a simple design and is easy to make, except for the VBA Programs. You can download this FormWizard from the link given at the end of this post and check the design, Property settings, VBA Routines, etc. An image of the Form Wizard in running mode is given below. The Wizard can create a simple Form in Column Format or Tabular Format. You can select a Table or Query for the Form from a Combo Box.

The Design Task.

Form and Tab Control

Open a new Form.
Insert a Tab Control on the Detail Section of the Form.
Select the First Page of the Tab Control and display the Property Sheet (View - -> Properties).
Change the Caption Property Value to Select Table. This description now appears on the First Page of Tab Control.

List Box and Property Settings
Create a List Box as shown on the design and position its child label on the top and give the Caption value Form Type.
Create a Label on the left side of the List Box and enter the Caption Text as shown.
Click on the List Box and display the Property Sheet.
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
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
Create a Label to the left of the Combo Box and change the Caption value as shown.

Command Buttons
Create a Command Button below and change the Caption to OK.
Create a second Command Button to the right and change the Caption to Cancel.
Select the second Tab Control Page, and change its Caption property Value to Select Fields.

List Boxes on Tab Page2
Create a List Box for Field List and a Second List Box for Selected Fields side by side as shown on the above design.
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
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
Create four small Command Buttons between the List Boxes as shown on the design.
Change their Name property Values as cmdRight, cmdRightAll, cmdLeft., cmdLeftAll from the first Command Button on the top of the fourth one at the bottom respectively.
Change their Caption Property Values with >, >>, < and << symbols as shown.
Create three Command Buttons below the List Boxes.
Change the Name Property Value of the left Command Button to cmdBack and the Caption Property Value to <.
Change the Name Property Value of the Command Button in the middle to cmdForm and the Caption Property Value to Finish.
Change the Name Property Value of the right side Command Button to cmdCancel2 and the Caption Property Value to Cancel.
Click to the right side of the second page of the Tab Control to select the Tab Control and display the Property Sheet.
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.
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.

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

NB: You must ensure that the Name Property Values of all objects are given correctly to avoid Run time errors. If you find any of the controls are not working as expected check whether the Name Property Value is given correctly and the On Click property is set with the Value [Event Procedure]. The On Click Property Value will automatically insert the [Event Procedure] if the Name of the control is the same as it is referenced in the VBA Routines.

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.
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.
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.
When you are ready to create the Form, Click on the Finish Command Button.