LEARN MS-ACCESS TIPS AND TRICKS: A Custom Made Form Wizard

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.

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

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

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 at one step. Fields which needs 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 easy to make, except the VBA Programs. You can download this FormWizard from the bottom of this Post and check the design, Property settings, VBA Routines etc. An image of the FormWizard 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.

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 the Tab Control.

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

Turn off the Wizard Tool on 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                    :  FilesList

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.

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 and change its Caption property Value to Select Fields.

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.

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 first Command Button on the top to 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 <<Back.

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

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

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.


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

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

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

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

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


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

NB:

Name

On Click

[Event Procedure]

On Click

[Event Procedure]

Open the FormWizard 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.