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.
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 Ill be subscribing to your feed and I hope you write again soon!
ReplyDelete[...] 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: [...]
ReplyDeleteAnonymous said...
ReplyDelete"End With" without "With..." in
"Public Function ResizePageFooter(ByVal strName As String)"