Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Reports - Page Border

Introduction

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

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


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 VB Module and change the Report Name in quotes to replace it with the name of your Report that you are pasting the code, 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.


The Page Footer Section

But, most of the time the Detail Section has 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 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 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.

Re-Sizing Page Footer

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 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 above code into a Global Module and save it. Run the code as you did in 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.

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