D
david epsom dot com dot au
This is code to fixup reports so that lines are displayed
correctly after export to snapshot and conversion to PDF
using Steven Lebans Report To PDF utility.
Lines are not well formed in snapshot files, so this
code converts all line controls to equivilant rectangles.
No attempt is made to catch diagonal or vertical lines.
Watch for line wrap.
(david)
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub fixup_lines()
'Public Domain (david)
On Error GoTo catch
Dim db As dao.Database
Dim rpt As Access.Report
Dim ctl As Access.Control
Dim ctlRect As Access.Control
Dim i As Integer
Dim iRptCount As Integer
Dim sRptName As String
Dim sCtlName As String
1110 Set db = CodeDb()
1120 iRptCount = db.Containers("reports").Documents.Count
1130 For i = 0 To iRptCount - 1
1140 sRptName = db.Containers("reports").Documents(i).Name
1150 DoCmd.OpenReport sRptName, acDesign
1160 Set rpt = Reports(sRptName)
1170 For Each ctl In rpt.Controls
1180 If ctl.ControlType = acLine Then
1190 Set ctlRect = Application.CreateReportControl( _
sRptName, acRectangle, ctl.Section, , , _
ctl.Left, ctl.Top, ctl.Width, ctl.Height)
1200 ctlRect.BorderWidth = ctl.BorderWidth
1210 sCtlName = ctl.Name
1220 Application.DeleteReportControl sRptName, sCtlName
1230 ctlRect.Name = sCtlName
1240 End If
1250 Next ctl
1260 DoCmd.Close acReport, sRptName, acSaveYes
Next_report:
Next i
Exit Sub
catch:
Debug.Print Erl, sRptName, Err.Description
Resume Next_report
End Sub
correctly after export to snapshot and conversion to PDF
using Steven Lebans Report To PDF utility.
Lines are not well formed in snapshot files, so this
code converts all line controls to equivilant rectangles.
No attempt is made to catch diagonal or vertical lines.
Watch for line wrap.
(david)
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub fixup_lines()
'Public Domain (david)
On Error GoTo catch
Dim db As dao.Database
Dim rpt As Access.Report
Dim ctl As Access.Control
Dim ctlRect As Access.Control
Dim i As Integer
Dim iRptCount As Integer
Dim sRptName As String
Dim sCtlName As String
1110 Set db = CodeDb()
1120 iRptCount = db.Containers("reports").Documents.Count
1130 For i = 0 To iRptCount - 1
1140 sRptName = db.Containers("reports").Documents(i).Name
1150 DoCmd.OpenReport sRptName, acDesign
1160 Set rpt = Reports(sRptName)
1170 For Each ctl In rpt.Controls
1180 If ctl.ControlType = acLine Then
1190 Set ctlRect = Application.CreateReportControl( _
sRptName, acRectangle, ctl.Section, , , _
ctl.Left, ctl.Top, ctl.Width, ctl.Height)
1200 ctlRect.BorderWidth = ctl.BorderWidth
1210 sCtlName = ctl.Name
1220 Application.DeleteReportControl sRptName, sCtlName
1230 ctlRect.Name = sCtlName
1240 End If
1250 Next ctl
1260 DoCmd.Close acReport, sRptName, acSaveYes
Next_report:
Next i
Exit Sub
catch:
Debug.Print Erl, sRptName, Err.Description
Resume Next_report
End Sub
