Ms-Access Advanced VBA Programming Techniques, Tips and Tricks.


Reports - Page Border

Drawing a Page Border is very easy in MS-Word and it is part of the Formatting Options and different artistic styles are also available. But when it comes to MS-Access we have to depend on Code to draw a Page Border before printing the Document. An Example Document image is given below:

The above Document is imported from Northwind.mdb Database (visit the Page Saving Data on Forms not in Tables for location reference of the Database) without the Page Border (Catalog Report attached to Categories Table) and drawn a double-lined Page Border with the help of Code given below. If you would like to try it out on the same Report then Import the Categories Table and the Catalog Report from Northwind.mdb database. The Code can be used on any Report that you wish to draw the Page Border and the border will be drawn within the Margin settings of the Page.

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

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

Exit Function

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 VB 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 Box Around Tabular Report Fields

Using the same method that we have used for drawing a Page Border we can draw boxes around the Tabular Fields arrangements on the Report's Detail Section without turning on the border of the fields. See the code in action on the Report that we have created in the earlier Post Highlighting Reports example below :

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

Exit Function

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

Copy and paste the following code into the Report's VB Module and change the Report Name in quotes to replace with the name of your Report that you are pasting the code into, 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 draws a nice Page Footer (a sample image is given below) with System Date and Number of Pages etc.

But, most of the time the Detail Section have to undergo changes and the Page Footer also must be changed. When a Report is designed manually without the help of Wizards then the Page Footer decoration must be hand drawn. To make things little more 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

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

Exit Function

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 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 Parameter to the function as follows:

DrawPageFooter "ReportName"

The Program will check through the length of the Controls present on 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.

There are times that even after drawing the Page Footer as the final step we may have second thoughts and go for modification of the Report by adding or removing fields and end up with a mismatch on the Page Footer part again. At this point either you may delete Page Footer elements and re-draw it or you may resize it with the help of the following Function:

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 ctrlCountWith sect.Controls(j)
    RW = .Left + .Width
    If RW > RWidth Then
       RWidth = RW
    End If
    If .Left < LW Then
       LW = .Left
    End If
End With
RWidth = RWidth - LW
Set sect = Rpt.Section(acPageFooter)
With sect .Controls("ULine")
   .Width = RWidth
   .Controls("Dated").Left = RWidth - .Controls("Dated").Width + LW
End With

Exit Function

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

Copy and paste the above code into a Global Module and save it. Run the code as you did for creating the Page Footer above. If you encounter any Error during compilation or Run time, visit the Page Command Button Animation and link the essential Library Files (7 or them) by going through the procedure explained there. Come back and re-try again.



  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!

  2. [...] PageBorder_Err: MsgBox Err.Description, , "PageBorder" Resume PageBorder_Exit End Function (source: added pageborder "myreport" to my report_open, but it returns the following error:error 2455: [...]




Infolinks Text Ads

Popular Posts

Search This Blog

Blog Archive

Powered by Blogger.


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

Featured Post

Activity Dates and Quarterly Reports

There are four Quarters in a Year: Jan - Mar = 1st Quarter Apr - Jun = 2nd Jul - Sep = 3rd Oct - Dec = 4th First three months of the yea...


Blog Archive

Recent Posts