LEARN MS-ACCESS TIPS AND TRICKS: Custom Wizards

Showing posts with label Custom Wizards. Show all posts

Opening External Access Report inside Active Database

a.p.r. pillaiJuly 31, 2013Custom Wizards 3 comments

Opening an External Access Report inside Active Database.

Last week, we explored how to print a Report from another MS Access database. Using VBA, we created a separate MS Access Application Window, opened the external database within that window, and printed a report from it. To accomplish this, we used the 'Application.DoCmd.OpenReport' command to open the report in Print Preview. The same code was also used within Excel (in a macro-enabled workbook) to preview the same MS Access report.

However, the procedure was somewhat complicated and not easy to follow—especially if you are not familiar with VBA.

Fortunately, if you only need to print a report or open a Form from an external MS Access database within your current database, there is a much simpler way.

By following the procedure explained below, you can open a report from another database directly in your current database window, either in Print Preview or Print mode, depending on how you configured it. With the same approach, you can also open forms just as easily.

Simple Preparations.

The procedure goes something like the following:

First, let us define the names of databases, reports, and Forms involved in this procedure, for reference.

Current Database Name: DatabaseA.mdb
Second Database Name: DatabaseB.mdb
Report to Print Preview from DatabaseB.mdb: myReport.
Form to open from DatabaseB.mdb: myForm.

Open DatabaseB.mdb (you may select any database having at least one Report and one Form).
Open the VBA Editing Window (ALT+F11).
Insert a new Standard Module (Insert -> Module).
Copy and paste the following VBA Code into the Module:
```
Public Function myReportOpen()
'Replace myReport with your own Report name in quotes.
   DoCmd.OpenReport "myReport", acViewPreview
End Function
```
Calling the above VBA Function from DatabaseA.mdb will open myReport from DatabaseB.mdb and will appear in the DatabaseA Application Window, in Print Preview.
Copy and paste the following VBA Code below the earlier Function myReportOpen():
```
Public Function myFormOpen()
 'Replace myForm with your own Form Name
   DoCmd.OpenForm "myForm", acViewNormal
End Function
```
We have created two simple functions in DatabaseB and ensured that DatabaseA does not have functions with the same name.
Save the VBA Module and close DatabaseB.mdb.
Open DatabaseA (any database you would like to see the Report/Form open from DatabaseB.mdb).
Open the VBA Editing Window (ALT+F11).

The Reference Library Usage.
Select Tools -> References.

You will see the VBA References Dialog box as shown below, with a lengthy list of available Library Files and the files already selected for the current project, check-marked and appearing at the top of the list. You must browse and locate DatabaseB.mdb, select it, and click Open to attach it to the current database as a Library File.
Use the Browse... button on the References Dialog Box, find DatabaseB.mdb from its folder, and open it. See that you have selected 'Microsoft Access Databases' in the Files of Type control; otherwise, Database file names will not appear.
The selected Database's Project Name (must be different from your database name) will appear at the bottom of the Library Files list.
Click OK to close the Dialog Box.
Now, the functions myReportOpen() and myFormOpen() of DatabaseB are visible in DatabaseA. It means you can call those functions from DatabaseA.mdb to open myReport or myForm from DatabaseB.mdb and display them in the DatabaseA Window.

How It Works.
Note: When the Function myReportOpen() is called from DatabaseA.mdb, it will first check for myReport in DatabaseB (the parent database of the function). If the report exists there, it will open from 'DatabaseB' and display in the current database window. If not, the function will then search for the report with the same name in DatabaseA.mdb and open it.
Keep this behavior in mind when working with library functions. By design, they look for referenced objects in the library file first. This feature can be useful when you are creating custom wizards or designing shared forms that need to work seamlessly across multiple databases.
At this point, you can test the programs by running them from the Debug Window.
Press CTRL+G to display the Debug Window (Immediate Window) if it is not already visible.
Type the following command in the Debug Window and press the Enter Key:
```
myReportOpen
```
The report will open in Print Preview mode behind the VBA window. To view it, simply minimize the VBA window. You can also test the myFormOpen() function to confirm that it works in the same way. For convenience, consider creating two command buttons on a form and call these functions from their Click event procedures, so you can run them directly from the form without opening the VBA editor each time.

Opening Form/Report of DatabaseB from DatabaseA
Open a form and create two Command Buttons on it.
Select the first command button and display its Property Sheet (F4).
Change the Name Property value to cmdReport.
Find the On Click Event property and select [Event Procedure] from the drop-down list.
Click on the build button (...) at the right end of the property to open the VBA Window.

You will find the opening and closing lines of a Subroutine, similar to the program lines given below, except for the middle line.
```
Private Sub cmdReport_Click()
   myReportOpen
End Sub
```
Copy the centerline of the above procedure and paste it into the middle of the VBA subroutine.
Similarly, name the second Command Button to cmdForm and follow the same steps (16 to 19) to create the following Sub-Routine in the VBA Window.
```
Private Sub cmdForm_Click()
   myFormOpen
End Sub
```
Save the Form.
Open the Form in normal view, click on the Command Button(s) to open myReport/myForm from DatabaseB.mdb. The user of your database will not know whether the Report is from the library database or from the active database.

Earlier Post Link References:

Custom Report Wizard

a.p.r. pillaiDecember 25, 2008Custom Wizards, msaccess wizards No comments

Custom-made Report Wizard.

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:

Make a copy of the Form Wizard and rename it as ReportWizard.
Open the ReportWizard in Design View.
Change the List Box and Combo Box headings to read as Report Format and Select Table/Query for Report, respectively.
Change the word 'Form' to Report in the left-side labels.
Display the Code Module of the ReportWizard by selecting View ->Code (or Alt+F11).
Press Ctrl+A to select the entire code in the Form Module and press the Delete Key to delete the Code.

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.

Open the Report Wizard in Normal View.
Select a Table or Query from the Combo Box.
Select the Tabular Wizard option from above.
Click OK to load the selected Table/Query Field List and open the List of Fields.
Select the Fields for the Report from the List Box.
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.

DrawPageFooter()
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:

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

Custom Made Form Wizard

a.p.r. pillaiDecember 13, 2008Custom Wizards, msaccess wizards 3 comments

The Custom-Made Form Wizard.

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:

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.
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, 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.

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.

List Box and Property Settings.
Create a List Box as shown in the design, position its child label at 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 ComboBox as given 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 Page 2.
Create a List Box for Field List and a Second List Box for Selected Fields side by side as shown in 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 to cmdRight, cmdRightAll, cmdLeft, and 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

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.

Open the Form Wizard in Normal View. Select one of the Form Design types, 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 and click the button labeled > 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.

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

Download the Demo Database:

Download Demo FormWizard.zip

Repairing Compacting Database with VBA

a.p.r. pillaiJune 13, 2008Custom Wizards, msaccess tips, Utilities 3 comments

Repairing and compacting the database.

Repairing and compacting the database is an essential maintenance task in Microsoft Access to keep the database size optimized and prevent performance issues. During regular use, MS Access creates temporary work objects within the database, causing the file size to grow over time.

If the database is used by a single user, this is not a major concern. You can simply enable the Compact on Close option in Access settings to automate this process:

Go to Tools → Options → General Tab
Check the box labeled Compact on Close

With this enabled, Access will automatically compact and repair the database each time it is closed.

However, if the database is shared on a network, enabling this feature can cause problems. Compacting requires exclusive access to the database, which means no other users can be connected while the process runs. If multiple users attempt to close the shared database, Access will attempt to compact it and fail, potentially leading to instability or corruption over time.

Granting Exclusive Access through Tools → Security → User and Group Permissions → Permissions Tab prevents multiple users from accessing the database concurrently, but that defeats the purpose of a shared system.

Access requires exclusive access during compacting because the process actually deletes the original database file and re-creates it. The compacting operation involves the following internal steps:

Database Compacting Steps.

Select Tools -> Database Utilities -> Compact and Repair Database. Closes the Current Database.
Creates a temporary Database named db1.mdb in the current folder.
Transfers all the Objects (Tables, Forms, Reports, etc.), except the work objects, into db1.mdb.
Deletes the original Database.
Renames the db1.mdb file to the original name.
Opens the newly created Database.

When No Database is active.

If no database is open when you select the Compact and Repair option, Microsoft Access prompts you to select the source database from your disk. It then asks you to specify the name and location for saving the compacted database. Access does not automatically overwrite the original database. Instead, it creates a new compacted copy, allowing you to decide whether to retain or replace the original file. Renaming the files is recommended for clarity and effective version control.

When compacting a database stored on a server, disk quota limitations can become a constraint. The user performing the operation must have available disk space equal to at least twice the size of the database, or more, within their allocated quota. This additional space is required because Access creates the compacted copy before the original database is removed or replaced.

In multi-user environments where multiple databases are shared across network folders, manually compacting each database can be time-consuming and inefficient. In such situations, a dedicated VBA-based Compacting Utility Program is invaluable. Such a utility can automatically compact multiple databases sequentially by following the same logical procedure described earlier (Steps 1 through 7), with minor modifications to efficiently process multiple databases.

The Compacting Utility that we create has the following advantages:

Uses Local Disk Space for the work file, instead of Network disk space, and runs the compacting process faster.
Can select more than one Database for compacting.
Takes a safe Backup on the Local Drive.
No failures due to the non-availability of enough Disk Space under the User's Disk Quota.

We will create a small Database with a Table to hold a list of Database Path Names, a Form, and two VBA Programs on the Form Module.

The Design Task.

Create a new Database with the name CompUtil.mdb.
Create a Table with the following structure.
Table: FilesList

Field Name Type Size

ID AutoNumber

dbPath Text 75

Save the Table with the name FilesList and key in the full path names of your Databases running on the Server, and close the table. Do not use the UNC type server addressing method:
```
"\\ ServerName\FolderName\DatabaseName" 
```
Right-click to open Large Image in New Tab/Window.
Open a new Form and create a List Box using the FilesList Table. See the design given below. Draw two Label Controls below the List Box and two Command Buttons below that, side by side.
Right-click to open Large Image in New Tab/Window.
Resize the Controls and position them to match the design given above. The finished design in Normal View is shown below. The Labels below the List Box are kept hidden and will appear only when the Program runs.
Right-click to open Large Image in New Tab/Window.
Change the Property Values of the Form and controls, so that your Form and design look exactly like the design given above.
Click on the List Box and display the property sheet (View -> Properties).
Change the List Box's Property Values as given below:
- Name: dbList
- Row Source Type: Table/Query
- Row Source: SELECT [FilesList].[ID], [FilesList].[dbPath] FROM [FilesList]
- Column Count: 2
- Column Heads: No
- Column Widths: 0.2396";1.4271"
- Bound Column: 2
- Enabled: Yes
- Locked: No
- Multiselect: Simple
- Tab Index: 0
- Left: 0.3021"
- Top: 0.7083"
- Width: 3.2083"
- Height: 1.7708"
- Back Color: 16777215
- Special Effect: Sunken
Resize the child Label Control, attached to the List Box, to the same size and position it above the List Box. Change the Caption to Database List.
Click on the first Label Control below the List Box, display the Property Sheet, and change the following Properties:
- Name: lblMsg
- Visible: No
- Left: 0.3021"
- Top: 2.5"
- Width: 3.2083"
- Height: 0.5"
- Back Color: 128
- Special Effect: Sunken
Display the Property Sheet of the second Label Control and change the following Properties:
- Name: lblstat
- Visible: No
- Left: 0.3021"
- Top: 3.0417"
- Width: 3.2083"
- Height: 0.1667"
- Back Style: Transparent
- Back Color: 16777215
- Special Effect: Flat
- Border Style: Transparent
Change the following properties of the left-side Command Button:
- Name: cmdRepair
- Caption: Repair/Compact
- Tab Index: 1
- Left: 0.3021"
- Top: 3.25"
- Width: 1.4271"
- Height: 0.2292"
Change the following properties of the right-side Command Button:
- Name: cmdClose
- Caption: Quit
- Tab Index: 1
- Left: 2.0833"
- Top: 3.25"
- Width: 1.4271"
- Height: 0.2292"
Change the Properties of the Form. Click on the left top corner of the Form where the left-side and Top design guides (Scales) meet. When you click there, a blue square will appear, indicating that the Form is selected. Display the Property Sheet and click on the All Tab. If that is not the current one, change the following Properties:
- Caption: External Repair/Compact Utility
- Default View: Single Form
- Views Allowed: Form
- Allow Edits: Yes
- Allow Deletions: No
- Allow Additions: No
- Data Entry: No
- Scroll Bars: Neither
- Record Selectors: No
- Navigation Buttons: No
- Dividing Lines: No
- Auto Resize: Yes
- Auto Center: Yes
- Pop up: Yes
- Modal: Yes
- Border Style: Dialog
- Control Box: Yes
- Min, Max Buttons: None
- Close Button: Yes
- Width: 3.9063"
Click on the Detail Section of the Form, and change the Height Property:
- Height: 3.7917"
Create a Header Label at the top with the Caption Compacting Utility, and set the Font Size to 18 Points.
NB: If you would like to create a Heading with 3D-style characters, as the sample shown above, visit the Page Create 3D Heading on Forms and follow the procedure explained there. You can do it later.
Select the Rectangle Tool from the Toolbox and draw a Rectangle around the Controls as shown on the Design.
Form Class Module Code.

Table: FilesList
Field Name	Type	Size
ID	AutoNumber
dbPath	Text	75

Display the VBA Module of the Form (View -\> Code), Copy, and paste the following code into it, and save the Form with the name Compacting.

Private Sub cmdClose_Click()
If MsgBox("Shut Down...?", vbYesNo + vbDefaultButton2 + vbQuestion, _"cmdQuit_Click()") = vbYes Then
    DoCmd.Quit
End If
End Sub

Private Sub cmdRepair_Click()
Dim lst As ListBox, lstcount As Integer
Dim j As Integer, xselcount As Integer
Dim dbname As String, t As Double, fs, f
Dim ldbName As String, strtmp As String

'create a temporary folder C:\tmp, if not present
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\tmp")
    If Err = 76 Or Err > 0 Then
       Err.Clear
       fs.createfolder ("c:\tmp")
    End If

On Error GoTo cmdRepair_Click_Err

Me.Refresh
Set lst = Me.dbList
lstcount = lst.ListCount - 1

xselcount = 0
For j = 0 To lstcount
If lst.Selected(j) Then
    xselcount = xselcount + 1
End If
Next

If xselcount = 0 Then
   MsgBox "No Database(s)Selected."
   Exit Sub
End If

If MsgBox("Ensure that Selected Databases are not in Use. " _
& vbCrLf & "Proceed...?", vbYesNo + vbDefaultButton2 + vbQuestion, "cmdRepair_Click()") = vbNo Then
   Exit Sub
End If

For j = 0 To lstcount
    If lst.Selected(j) Then
      dbname = lst.Column(1, j)
       dbname = Trim(dbname)
       ldbName = Left(dbname, Len(dbname) - 3)
       ldbName = ldbName & "ldb" 'for checking the presense of lock file.
       If Len(Dir(ldbName)) > 0 Then 'database is active
          MsgBox "Database: " & dbname v vbCrLf & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If

       If MsgBox("Repair/Compact: " & dbname & vbCrLf & "Proceed...?", vbQuestion + vbDefaultButton2 + vbYesNo, "cmdRepair_Click()") = vbYes Then
            Me.lblMsg.Visible = True
            Me.lblStat.Caption = "Working, Please wait..."
            Me.lblStat.Visible = True
            DoEvents

            dbCompact dbname 'run compacting

            Me.lblStat.Caption = ""
            DoEvents

nextstep:
            t = Timer
            Do While Timer <= t + 7 'delay loop
               DoEvents 'do nothing
            Loop
        End If
    End If
Next

   Me.lblMsg.Visible = False
   Me.lblStat.Caption = ""
   Me.lblStat.Visible = False

strtmp = "c:\tmp\db1.mdb" 'Delete the temporary file
If Len(Dir(strtmp)) > 0 Then
  Kill strtmp
End If

Set fs = Nothing
Set f = Nothing
Set lst = Nothing

cmdRepair_Click_Exit:
Exit Sub

cmdRepair_Click_Err:
MsgBox Err.Description, , "cmdRepair_Click()"
Resume cmdRepair_Click_Exit
End Sub

Private Function dbCompact(ByVal strdb As String)
Dim t As Long
Dim xdir As String, strbk As String
Const tmp As String = "c:\tmp\"

On Error GoTo dbCompact_Err

If Len(Dir(tmp & "db1.mdb")) > 0 Then
    Kill tmp & "db1.mdb"
End If

t = InStrRev(strdb, "\")
If t > 0 Then
   strbk = Mid(strdb, t + 1)
End If
strbk = tmp & strbk

xdir = Dir(strbk)
If Len(xdir) > 0 Then
   Kill strbk
End If
'Make a Copy in c:\tmp folder as safe backup
Me.lblMsg.Caption = "Taking Backup of " & strdb & vbCrLf _
& "to " & tmp
DoEvents

   DBEngine.CompactDatabase strdb, strbk

Me.lblMsg.Caption = "Transferring Objects from " & strdb & vbCrLf _
& "to " & tmp & "db1"
DoEvents

   DBEngine.CompactDatabase strdb, tmp & "db1.mdb"

' Delete uncompacted Database and Copy Compacted db1.mdb with
' the Original Name

lblMsg.Caption = "Creating " & strdb & " from " & tmp & "db1.mdb"
DoEvents

    If Len(Dir(strdb)) > 0 Then
        Kill strdb
    End If

    DBEngine.CompactDatabase tmp & "db1.mdb", strdb

lblMsg.Caption = strdb & " Compacted Successfully." & vbCrLf & "Database backup copy saved at Location: " & tmp
DoEvents

dbCompact_Err_Exit:
Exit Function

dbCompact_Err:
MsgBox Err & " : " & Err.Description, , "dbCompact()"
  Resume dbCompact_Err_Exit
End Function

You can set the Compacting Form to open at Startup. Select Startup from the Tools Menu. Select Form Compacting in the Display Form/Page Control. To hide the Database Window, remove the check mark from the Display Database Window Option.

The Trial Run

Open the Compacting Form in Normal view. Select one or more Databases from the List Box for Compacting.
Click the Repair/Compact Command Button.

When you run the program for the first time, it checks for the folder C:\tmp. If that folder is not found, the program automatically creates it. This directory serves as the working area for the Compacting Utility—regardless of whether the program is executed from the server or a local drive. All backup copies of the compacted databases are stored in this location for safekeeping.

Before initiating the compacting process, the program performs a status check on each selected database to ensure that no users are currently accessing it. If a database is found to be in use, the program will display a notification message. The compacting operation is skipped for that particular database, preventing potential file conflicts or data corruption.

The Label Controls that we have created and kept hidden under the List Box will be made visible. It will be updated with the program's current activity information at different stages of the Compacting Procedure.

Any suggestions for improvement of this Program are welcome.

The Demo Database is upgraded to MS-Access Version 2016 and can be downloaded from the link below.

Download Repairing.zip

Edit Data in Zoom-In Control

a.p.r. pillaiAugust 02, 2007Custom Wizards, Forms, msaccess forms 8 comments

Editing Overflowing Field Contents in a Zoom Window.

While designing a Form, Report, or Query, certain property fields—such as Record Source, Filter, or Order By—can be more comfortably edited using the Zoom feature. To use it:

Right-click on the property box (e.g., Record Source),
A shortcut menu will appear with a Zoom… option,
Click Zoom… to open a larger, resizable window where you can edit the property value with ease.

✦ This feature is especially useful for writing long SQL statements, expressions, or formulas that don’t fit well in the default single-line input box.

However, the Zoom option is not available while entering or editing data on Forms, especially for large Text or Memo fields (now called Long Text in newer versions of Access). These fields often hold more data than what is visible in the control's limited display area.

In such cases, users must either:

Rely on navigating and scrolling within the control itself, or
Use alternative solutions, like a pop-up form or a double-click event to open a larger edit window.

Adding a double-click event on such controls to launch a Zoom-like custom form can greatly enhance user experience.

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

The Zoom Tool Button is available under the Properties category of the built-in Shortcut Menus for Forms, Reports, Queries, and Indexes. You can copy this Zoom button and paste it onto your custom Shortcut Menu—or even onto the built-in Form View control shortcut menu, just like we did with the Animated Floating Calendar feature. This allows users to access the Zoom window conveniently while working on Forms, especially for fields with large amounts of text.

Designing the Zoom Control

But we are going to take a different approach—we’ll design our own Zoom-In control. It will be both interesting and insightful to explore how this custom feature works behind the scenes.

We can create this quite easily—all we need is a small form, two simple VBA routines, and a shortcut menu button, similar to the one we added earlier to the Form View Control sub-menu for our Animated Floating Calendar.

Open a new Form and design a Text Box and two Command Buttons as shown below:

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

Set the properties of the Form, Text Box, and Command Buttons as given below:

Display the Form's Property Sheet (Press Alt+ENTER) and change the following Form Properties:
- Caption = Zoom
- Default View = Single Form
- Allow Edits = Yes
- Allow Deletions = No
- Allow Additions = No
- Data Entry = No
- Scroll Bar = Neither
- Record Selectors = No
- Navigation Buttons = No
- Dividing Lines = No
- Auto Resize = Yes
- Auto Center = Yes
- Popup = Yes
- Modal = Yes
- Border Style = Dialog
- Control Box = Yes
- Min Max Buttons = None
- Close Button = Yes
- What's this Button = No
- Width = 5.4583"
- Allow Design Changes = Design View Only
- Movable = Yes
Click on the Detail Section of the Form and change the Height and other properties as shown below:
- Height = 2.4167"
Text Box and Command Buttons Properties
Text Box Properties:
- Name = txtZoom
- Left = 0.2083"
- Top = 0.1667"
- Width = 4.1875"
- Height = 2.0417"
Command Button1 :
- Name = cmdOK
- Caption = OK
Command Button2 :
- Name = cmdCancel
- Caption = Cancel
Display the Form's VB Module (Click on the Code Toolbar Button above (when the Form is still in Design View) or select Code from the View Menu), copy and paste the code given below into the Form Module, and save the Form with the name Zoom.
```
Private Sub cmdCancel_Click()
    DoCmd.Close acForm, "Zoom"
End Sub

Private Sub cmdOK_Click()
   CloseZoom
End Sub
```
Create a Custom Toolbar Button
Create a custom toolbar button using the method described in the earlier Article: Custom Menu Bars and Toolbars. You can place this button on:
- Your main toolbar above,
- your custom shortcut menu (if you’ve already created one), or
- The Form View Control submenu under the Forms section of the built-in shortcut menu, just like we did when adding the button for the Animated Floating Calendar.
Right-click the button and display properties. Type =ZoomOpen() in the Action control and close the Toolbar Customize Dialogue control.

Copy and paste the following VBA code in the Global Module and save it.

Public Function ZoomOpen()
'------------------------------------------------------
'  Author  : a.p.r. pillai
'  Date    : 29/07/2007
'  Remarks: Open Zoom Control with Active Field's Data
'------------------------------------------------------ 
Dim varVal, ctl As Control, intFontWeight As Integer
Dim strFont As String, intFontSize As Integer
Dim BoolFontstyle As Boolean, boolFontUnderline As Boolean

On Error GoTo ZoomOpen_Err

Set ctl = Screen.ActiveControl   
strFont = ctl.FontName   
intFontSize = ctl.FontSize   
intFontWeight = ctl.FontWeight   
BoolFontstyle = ctl.FontItalic   
boolFontUnderline = ctl.FontUnderline

varVal = Screen.ActiveControl.Value   
DoCmd.OpenForm "Zoom", acNormal

With Screen.ActiveForm.Controls("TxtZoom")
   .Value = varVal
   .FontName = strFont
   .FontSize = intFontSize
   .FontWeight = intFontWeight
   .FontItalic = BoolFontstyle
   .FontUnderline = boolFontUnderline
End With

ZoomOpen_Exit:
Exit Function

ZoomOpen_Err:
Resume ZoomOpen_Exit
End Function

Public Function CloseZoom()
'------------------------------------------------------
'  Author : a.p.r. pillai
'  Date   : 29/07/2007
'  Save Edited Data back into the Source Field
'------------------------------------------------------ 
Dim vartxtZoom, strControl As String

On Error GoTo CloseZoom _Err
'copy the Edited Data into the Variable vartxtZoom 
vartxtZoom = Forms("Zoom").Controls("txtZoom").Value
'close the Zoom Form 
DoCmd.Close acForm, Screen.ActiveForm.NAME

'The Source Data field become active again 
If Screen.ActiveControl.Locked = True Then
   strControl = Screen.ActiveControl.NAME
   MsgBox "Read-Only Field. Changes will not be Saved.", "Control : " & strControl
   GoTo CloseZoom _Exit 
Else
    If IsNull(vartxtZoom) = False And Len(vartxtZoom) > 0 Then
        Screen.ActiveControl.Text = vartxtZoom
    End If 
End If

CloseZoom _Exit:
Exit Function

CloseZoom _Err:
Resume CloseZoom _Exit
End Function

Open one of your data entry forms, preferably one that includes a memo field with 2 or 3 lines of text. Right-click the memo field (or any other field you prefer) to display the shortcut menu, and click on the custom Zoom button that you added earlier.

If you placed the button on a toolbar above, make sure to first select the target field on the form to activate it, then click the toolbar button to trigger the zoom action.

In my case, I added the Zoom button to my custom shortcut menu and designed a custom button image for it. The icon depicts a small area being enlarged into a big window, but once finished, the image now resembles a CRT monitor.
Right-click to open a Large Image in New Tab/Window
When the Zoom button is clicked, it calls the first function: =ZoomOpen(). This opens the Zoom In window, displaying the contents of the active field in a text box named txtZoom for easy editing. The font properties (such as font name, size, and style) of the original control are automatically applied to the Zoom In text box, ensuring a consistent look and feel during editing.
After adding or editing the text, click the OK button on the Zoom Control to save the changes back to the source field and close the window. If the Cancel button is clicked instead, the Zoom Control closes without saving any changes, leaving the original field data unchanged.

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

If the active field is locked for editing, the Zoom In control will still open and display the field's data. However, when attempting to save changes, a message will appear indicating that the field is read-only, and the control will close without saving any edits.

If the source field is locked for editing, it's better not to open the Zoom In window at all with read-only data. Allowing the user to make changes only to reject them at the point of saving—with a warning—can feel frustrating and diminish the reliability of our Zoom In control.

Before opening the Zoom window, check whether the active field is locked for editing. If it is, display an appropriate message and skip opening the Zoom In control altogether. I’ll leave this enhancement as an exercise for you. Try modifying the code yourself—and if you run into any difficulty, feel free to ask me for help.

Download

Download Demo Database

Opening an External Access Report inside Active Database.

The Reference Library Usage.

How It Works.

Opening Form/Report of DatabaseB from DatabaseA

Earlier Post Link References:

Custom-made Report Wizard.

Designing Report Wizard.

Report Wizard VBA Code.

Create Left-side ListBox Items.

Create Right-side ListBox Items.

Create a Report In Tabular Format.

Create a Report In Columns Format.

Create the Report's Page-Footer Contents.

Try out the Report Wizard.

Download Custom Report Wizard.

The Custom-Made Form Wizard.

Built-in Form Wizard Review.

The Design Task.

Form and Tab Control.

List Box and Property Settings.

Combo Box and Property Settings

Command Buttons.

List Boxes on Tab Page 2.

Command Buttons between List Boxes.

The Form Wizard VBA Code.

Create Left-side ListBox Items.

Create Right-side ListBox Items.

Create Tabular Type Form.

Create Form in Columns Format

Download the Demo Database:

Repairing and compacting the database.

Database Compacting Steps.

When No Database is active.

The Design Task.

Form Class Module Code.

The Trial Run

Editing Overflowing Field Contents in a Zoom Window.

Designing the Zoom Control

Text Box and Command Buttons Properties

Create a Custom Toolbar Button

Download

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

Post Feed

Get new posts by email:

Search

USEFUL LINKS

Popular Posts

About Me

Blog Archive

Labels

Statcounter