Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Reports - Page Border

Drawing a Page Border in MS Access.

Drawing a page border in Microsoft Word is a simple task—it’s available as part of the built-in Formatting Options, and you can even choose from a variety of artistic styles.

However, when it comes to Microsoft Access, there are no direct formatting tools for adding a decorative or functional border around a printed Report Page. Instead, we must rely on VBA code to draw the page border programmatically at runtime, just before the report is printed.

The example image below illustrates a report with a custom-drawn page border created using this method.

The Catalog Report shown above was imported from the Northwind.mdb database (refer to the article Saving Data on Forms Not in Tables for database location details). Originally, this report did not include a page border. We enhanced it by drawing a double-lined page border using the VBA code provided below.

If you'd like to try this yourself, import both the Categories table and the Catalog Report from the Northwind.mdb database into your project. The code can be used on any report to draw a page border, and it automatically aligns the border within the page’s margin settings.

The VBA Code.

Public Function PageBorder(ByVal strReportName As String)
Dim Rpt As Report, lngColor As Long
Dim sngTop As Single, sngLeft As Single
Dim sngwidth As Single, sngheight As Single

On Error GoTo PageBorder_Err

'DRAW DOUBLE LINED BORDER
Set Rpt = Reports(strReportName)
'Set scale to pixels
Rpt.ScaleMode = 3 
'Top inside edge
sngTop = Rpt.ScaleTop
'Left inside edge
sngLeft = Rpt.ScaleLeft
'Width inside edge
sngwidth = Rpt.ScaleWidth
'Height inside edge
sngheight = Rpt.ScaleHeight
'color value
lngColor = RGB(0, 0, 255)
'Draw page Border
Rpt.Line (sngTop, sngLeft)-(sngwidth, sngheight), lngColor, B

sngTop = Rpt.ScaleTop + 10
sngLeft = Rpt.ScaleLeft + 10
sngwidth = Rpt.ScaleWidth - 10
sngheight = Rpt.ScaleHeight - 10

Rpt.Line (sngTop, sngLeft)-(sngwidth, sngheight), lngColor, B

PageBorder_Exit:
Exit Function

PageBorder_Err:
MsgBox Err.Description, , "PageBorder"
Resume PageBorder_Exit
End Function

Copy and paste the above Code into a Global Module and save it. Copy the following lines into the VBA Module of the Report that you wish to draw the page border:

Private Sub Report_Page()
    PageBorder "Catalog"
End Sub

Replace the name "Catalog" with the name of your Report. Print Preview or Print the Report.

Draw a Box Around Tabular Report Fields.

Using the same technique employed to draw a page border, we can also draw boxes around tabular field arrangements in the Detail section of a report, without enabling the borders of individual controls. This allows for a cleaner and more flexible design.

You can see this method in action on the report we created in the previous post: Highlighting Reports. The example below demonstrates how the code draws precise rectangular outlines around each row of data during print preview or printing, enhancing the report’s readability and structure.


The DrawBox() Function.

A separate Function with the name DrawBox() is created, with the same Code without the code for the second box. Copy and paste the following Code into a Global Module and save it:

Public Function DrawBox(ByVal strName As String)
Dim Rpt As Report, lngColor As Long
Dim sngTop As Single, sngLeft As Single
Dim sngwidth As Single, sngheight As Single

On Error GoTo DrawBox_Err

    Set Rpt = Reports(strName)    
' Set scale to pixels.    
Rpt.ScaleMode = 3    
' Top inside edge.    
sngTop = Rpt.ScaleTop ' + 5    
' Left inside edge.    
sngLeft = Rpt.ScaleLeft ' + 5    
' Width inside edge.

sngwidth = Rpt.ScaleWidth ' - 10    
' Height inside edge.    
sngheight = Rpt.ScaleHeight '- 10    
' Make color red.    
lngColor = RGB(255, 0, 0)    
' Draw line as a box.    
Rpt.Line (sngTop, sngLeft)-(sngwidth, sngheight), lngColor, B

DrawBox_Exit:
Exit Function

DrawBox_Err:
MsgBox Err.Description, , "DrawBox"
Resume DrawBox_Exit
End Function

Copy and paste the following code into the Report's VBA Module and change the Report Name in quotes to replace it with the Report's Name, to run the code in Detail_Print() Event Procedure:

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
        DrawBox "SalesTarget2"
End Sub

When the built-in Report Wizard prepares a Report, it creates a nice Page Footer (a sample image is provided below) with the system date, number of Pages, and other details.


The Page Footer Section.

However, most of the time, the Detail Section needs to undergo changes, and the Page Footer must also be updated. When a Report is designed manually without the help of Wizards, then the Page Footer decoration must be hand-drawn. To make things a little easier, I have written two Functions, and the Code is given below:

Public Function DrawPageFooter(ByVal strName As String)
'--------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : 22/08/2007
'Remarks: Draws Report Page Footer
'--------------------------------------------------------------
Dim lngWidth As Long, ctrwidth As Long, ctrlCount As Long
Dim j As Long, obj As Report, 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
'       are 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 DrawPageFooter_Err

Set cdb = CurrentDb
Set obj = Reports(strName)
Set rptSection = obj.Section(acDetail)

ctrlCount = rptSection.Controls.Count - 1

lngleft = rptSection.Controls(0).Leftrightmost = 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 * 1440lng
Width = 0: ctrwidth = 0

   lngWidth = rightmost + rptSection.Controls(RightIndx).Width
   lngWidth = lngWidth - lngleft

  Set LineCtrl = CreateReportControl(strName, acLine, acPageFooter, "", "", lngleft, lngtop, lngWidth, 0)
  Set ctrl = LineCtrl
  LineCtrl.BorderColor = 12632256
  LineCtrl.BorderWidth = 2
  LineCtrl.Name = "ULINE"

lngtop = 0.0418 * 1440
lngleft = LineCtrl.Left
lngWidth = 2 * 1440
lngheight = 0.229 * 1440

'draw Page Number control at the Report footer

Set LineCtrl = CreateReportControl(strName, acTextBox, acPageFooter, "", "", lngleft, lngtop, lngWidth, lngheight)
With LineCtrl
   .ControlSource = "='Page : ' & [page] & ' / ' & [pages]"
   .Name = "PageNo"
   .FontName = "Arial"
   .FontSize = 10
   .FontWeight = 700
   .TextAlign = 1
End With
'draw Date Control at the right edge of the Line Control
'calculate left position of Date control

lngleft = (LineCtrl.Left + ctrl.Width) - lngWidth
Set LineCtrl = CreateReportControl(strName, acTextBox, acPageFooter,  "", "", lngleft, lngtop, lngWidth, lngheight)
With LineCtrl
   .ControlSource = "='Date : ' & Format(Date(),'dd/mm/yyyy')"
   .Name = "Dated"
   .FontName = "Arial"
   .FontSize = 10
   .FontWeight = 700
   .TextAlign = 3
End With

DrawPageFooter_Exit:
Exit Function

DrawPageFooter_Err:
MsgBox Err.Description, , "DrawPageFooter"
Resume DrawPageFooter_Exit
End Function

Copy and paste the above Code into a Global Module and save it. When the Report design is complete, except for the Page Footer part, call this Function (still keeping the Report open in Design View) from the Debug Window (Immediate Window) or run the code from a Button_Click() Event Procedure by giving the Report Name as a Parameter to the function as follows:

DrawPageFooter "ReportName"

The Program will check through the length of the Controls present in the Detail Section of the Report and add up the length of all fields to calculate the total length of the Page Footer. The Program assumes that the Controls are arranged close together without leaving gaps between them.

Resizing Page Footer.

There are times when, even after designing the Page Footer as the final step, we revisit the report for modifications—such as adding or removing fields—which may result in a misaligned or overlapping Page Footer. When this happens, you have two options:

  1. Delete and redraw the Page Footer elements manually, or

  2. Resize and realign them programmatically using the following utility function.

This function streamlines the process of dynamically adjusting the layout, helping you save time while maintaining a consistent and professional appearance across all pages.

Public Function ResizePageFooter(ByVal strName As String)
Dim RWidth As Long, sect As Section, Rpt As Report
Dim ctrlCount As Integer, j As Integer, RW As Long, LW As Long

On Error GoTo ResizePageFooter_Err

Set Rpt = Reports(strName)
Set sect = Rpt.Section(acDetail)ctrlCount = sect.Controls.Count - 1
RWidth = sect.Controls(0).Width + sect.Controls(0).Left
LW = sect.Controls(0).Left
For j = 0 To ctrlCount
With sect.Controls(j)
    RW = .Left + .Width
    If RW > RWidth Then
       RWidth = RW
    End If
    If .Left < LW Then
       LW = .Left
    End If
End With
Next
RWidth = RWidth - LW
Set sect = Rpt.Section(acPageFooter)
With sect 
	.Controls("ULine")
   .Width = RWidth
   .Controls("Dated").Left = RWidth - .Controls("Dated").Width + LW
End With

ResizePageFooter_Exit:
Exit Function

ResizePageFooter_Err:
MsgBox Err.Description, "ResizePageFooter"
Resume ResizePageFooter_Exit
End Function

Copy and paste the code into a Global Module, then save it.
To run the code, follow the same procedure you used earlier when creating the Page Footer.

If you encounter any compilation or runtime errors, it's likely due to missing references.
In that case, visit the post titled Command Button Animation and follow the steps outlined there to link the seven essential library files required for proper execution.
Once the references are set, return to this module and run the program again.

Share:

3 comments:

  1. Pretty nice post. I just stumbled upon your blog and wanted to say that I have really enjoyed browsing your blog posts. In any case I’ll be subscribing to your feed and I hope you write again soon!

    ReplyDelete
  2. [...] PageBorder_Err: MsgBox Err.Description, , "PageBorder" Resume PageBorder_Exit End Function (source: http://msaccesstips.com/2007/08/reports-page-border/)I added pageborder "myreport" to my report_open, but it returns the following error:error 2455: [...]

    ReplyDelete
  3. Anonymous said...

    "End With" without "With..." in
    "Public Function ResizePageFooter(ByVal strName As String)"

    ReplyDelete

Comments subject to moderation before publishing.

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

PageRank

Post Feed


Search

Popular Posts

Blog Archive

Powered by Blogger.

Labels

Forms Functions How Tos MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Class Module External Links Queries Array msaccess reports Accesstips WithEvents msaccess tips Downloads Objects Menus and Toolbars Collection Object MsaccessLinks Process Controls Art Work Property msaccess How Tos Combo Boxes Dictionary Object ListView Control Query VBA msaccessQuery Calculation Event Graph Charts ImageList Control List Boxes TreeView Control Command Buttons Controls Data Emails and Alerts Form Custom Functions Custom Wizards DOS Commands Data Type Key Object Reference ms-access functions msaccess functions msaccess graphs msaccess reporttricks Command Button Report msaccess menus msaccessprocess security advanced Access Security Add Auto-Number Field Type Form Instances ImageList Item Macros Menus Nodes RaiseEvent Recordset Top Values Variables Wrapper Classes msaccess email progressmeter Access2007 Copy Excel Export Expression Fields Join Methods Microsoft Numbering System Records Security Split SubForm Table Tables Time Difference Utility WScript Workgroup database function msaccess wizards tutorial Access Emails and Alerts Access Fields Access How Tos Access Mail Merge Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting ChDir Color Palette Common Controls Conditional Formatting Data Filtering Database Records Defining Pages Desktop Shortcuts Diagram Disk Dynamic Lookup Error Handler External Filter Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Message Box Monitoring Octal Numbers Operating System Paste Primary-Key Product Rank Reading Remove Rich Text Sequence SetFocus Summary Tab-Page Union Query User Users Water-Mark Word automatically commands hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar updating upload vba code