Answered by:
Set report margins using VBA

Question
-
I am using Access 2010. I have a large number of reports which I need to change the margins on due to a change in letterhead. Rather than go through each in design mode and change the page settings I would like to use VBA to open each in design mode and do it automatically. I threw together the following which runs without error, but does not actually change the margins. What am I doing wrong besides not getting enough sleep?
Sub SetLetterMargins() Const LEFT_MARGIN As Long = 1440 ' 1" Const RIGHT_MARGIN As Long = 1080 ' .75" Const TOP_MARGIN As Long = 493 ' .342" Const BOTTOM_MARGIN As Long = 1800 ' 1.25" '----------------------------------------------------------------------------------- ' Set left and right margins on all "rptLtr_Att" letters '----------------------------------------------------------------------------------- Dim prt As Printer Dim rpt As AccessObject Dim strRptName As String Dim fSave As Boolean For Each rpt In Application.CurrentProject.AllReports strRptName = rpt.Name If strRptName Like "rptLtr_Att*" Then DoCmd.OpenReport strRptName, acDesign fSave = False Set prt = Reports(strRptName).Report.Printer Debug.Print strRptName; If prt.LeftMargin <> LEFT_MARGIN Then Debug.Print Tab(40); "Current LeftMargin="; prt.LeftMargin; " resetting to "; LEFT_MARGIN prt.LeftMargin = LEFT_MARGIN fSave = True End If If prt.RightMargin <> RIGHT_MARGIN Then Debug.Print Tab(40); "Current RightMargin="; prt.RightMargin; " resetting to "; RIGHT_MARGIN prt.RightMargin = RIGHT_MARGIN fSave = True End If If prt.TopMargin <> TOP_MARGIN Then Debug.Print Tab(40); "Current TopMargin="; prt.TopMargin; " resetting to "; TOP_MARGIN prt.TopMargin = TOP_MARGIN fSave = True End If If prt.BottomMargin <> BOTTOM_MARGIN Then Debug.Print Tab(40); "Current BottomMargin="; prt.BottomMargin; " resetting to "; BOTTOM_MARGIN prt.BottomMargin = BOTTOM_MARGIN fSave = True End If If fSave Then Set Reports(strRptName).Report.Printer = prt DoCmd.Close acReport, strRptName, acSaveYes Debug.Print Tab(40); "Saved." Else DoCmd.Close acReport, strRptName, acSaveNo End If End If Next rpt End Sub
-Bruce
Wednesday, March 15, 2017 5:03 PM
Answers
-
This is the oddest thing. If you step through your code and check the page setup the values are properly applied. It is specifically the Save process that isn't working properly!
What you have to do, and I've tested, is you need to change any report property to another value, then set it back to what it was and then proceed with your close and save. Basically Access doesn't seem the recognize the margin changes as having changed the report so your save does not actually save anything. By making a dummy change, it will then see that things changes and save it all. It's nuts, but it works! One more bug to add to the long list!!!
Hope this helps.
It's not you, it's MS.
Here's one way it could be done.
Public Sub SetLetterMargins() Const LEFT_MARGIN As Long = 1440 ' 1" Const RIGHT_MARGIN As Long = 1080 ' .75" Const TOP_MARGIN As Long = 493 ' .342" Const BOTTOM_MARGIN As Long = 1800 ' 1.25" '----------------------------------------------------------------------------------- ' Set left and right margins on all "rptLtr_Att" letters '----------------------------------------------------------------------------------- Dim prt As Printer Dim rpt As AccessObject Dim rpt2 As Access.Report Dim strRptName As String Dim fSave As Boolean 10 On Error GoTo Error_Handler 20 For Each rpt In Application.CurrentProject.AllReports 30 strRptName = rpt.Name 40 If strRptName Like "rptLtr_Att*" Then 50 DoCmd.OpenReport strRptName, acDesign 60 fSave = False 70 Set prt = Reports(strRptName).Report.Printer 80 Debug.Print strRptName; 90 If prt.LeftMargin <> LEFT_MARGIN Then 100 Debug.Print Tab(40); "Current LeftMargin="; prt.LeftMargin; " resetting to "; LEFT_MARGIN 110 prt.LeftMargin = LEFT_MARGIN 120 fSave = True 130 End If 140 If prt.RightMargin <> RIGHT_MARGIN Then 150 Debug.Print Tab(40); "Current RightMargin="; prt.RightMargin; " resetting to "; RIGHT_MARGIN 160 prt.RightMargin = RIGHT_MARGIN 170 fSave = True 180 End If 190 If prt.TopMargin <> TOP_MARGIN Then 200 Debug.Print Tab(40); "Current TopMargin="; prt.TopMargin; " resetting to "; TOP_MARGIN 210 prt.TopMargin = TOP_MARGIN 220 fSave = True 230 End If 240 If prt.BottomMargin <> BOTTOM_MARGIN Then 250 Debug.Print Tab(40); "Current BottomMargin="; prt.BottomMargin; " resetting to "; BOTTOM_MARGIN 260 prt.BottomMargin = BOTTOM_MARGIN 270 fSave = True 280 End If 290 If fSave Then 'Make a random change 300 Set rpt2 = Reports(strRptName).Report 310 With rpt2 320 If .DefaultView = 0 Then 330 .DefaultView = 1 340 Else 350 .DefaultView = 0 360 End If 'Set it back 370 If .DefaultView = 0 Then 380 .DefaultView = 1 390 Else 400 .DefaultView = 0 410 End If 420 End With 430 Set rpt2 = Nothing 440 Set Reports(strRptName).Report.Printer = prt 450 DoCmd.Close acReport, strRptName, acSaveYes 460 Debug.Print Tab(40); "Saved." 470 Else 480 DoCmd.Close acReport, strRptName, acSaveNo 490 End If 500 End If 510 Next rpt Error_Handler_Exit: 520 On Error Resume Next 530 Exit Sub Error_Handler: 540 MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: SetLetterMargins" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occured!" 550 Resume Error_Handler_Exit End Sub
Daniel Pineault, 2010-2016 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net
- Marked as answer by Bruce Hulsey Wednesday, March 15, 2017 10:47 PM
- Edited by Daniel Pineault (MVP)MVP Thursday, March 16, 2017 12:43 AM
Wednesday, March 15, 2017 10:37 PM
All replies
-
Have you stepped through the code to see if it is doing what you expect (besides not saving the changes).?
Bill Mosca
www.thatlldoit.com
http://tech.groups.yahoo.com/group/MS_Access_ProfessionalsWednesday, March 15, 2017 5:26 PM -
Yes, it acts exactly as I expect it would. It's not skipping anything unexpectedly. It properly loops through all of the reports and all of the appropriate debug.print statements are hit, e.g:
rptLtr_Att30_SP Current LeftMargin= 3255 resetting to 1440
Current RightMargin= 720 resetting to 1080
Current TopMargin= 576 resetting to 493
Current BottomMargin= 720 resetting to 1800
Saved.
rptLtr_Att31_SP Current LeftMargin= 3255 resetting to 1440
Current RightMargin= 720 resetting to 1080
Current TopMargin= 576 resetting to 493
Current BottomMargin= 720 resetting to 1800
Saved.etc.
I think I am just misunderstanding the relationship between each report's Printer object and what is shown in the margins section of the Print Options tab on the Page Setup dialog. Either that, or I am not saving things properly in the "If fSave..." section of my code.
-Bruce
Wednesday, March 15, 2017 5:46 PM -
This is the oddest thing. If you step through your code and check the page setup the values are properly applied. It is specifically the Save process that isn't working properly!
What you have to do, and I've tested, is you need to change any report property to another value, then set it back to what it was and then proceed with your close and save. Basically Access doesn't seem the recognize the margin changes as having changed the report so your save does not actually save anything. By making a dummy change, it will then see that things changes and save it all. It's nuts, but it works! One more bug to add to the long list!!!
Hope this helps.
It's not you, it's MS.
Here's one way it could be done.
Public Sub SetLetterMargins() Const LEFT_MARGIN As Long = 1440 ' 1" Const RIGHT_MARGIN As Long = 1080 ' .75" Const TOP_MARGIN As Long = 493 ' .342" Const BOTTOM_MARGIN As Long = 1800 ' 1.25" '----------------------------------------------------------------------------------- ' Set left and right margins on all "rptLtr_Att" letters '----------------------------------------------------------------------------------- Dim prt As Printer Dim rpt As AccessObject Dim rpt2 As Access.Report Dim strRptName As String Dim fSave As Boolean 10 On Error GoTo Error_Handler 20 For Each rpt In Application.CurrentProject.AllReports 30 strRptName = rpt.Name 40 If strRptName Like "rptLtr_Att*" Then 50 DoCmd.OpenReport strRptName, acDesign 60 fSave = False 70 Set prt = Reports(strRptName).Report.Printer 80 Debug.Print strRptName; 90 If prt.LeftMargin <> LEFT_MARGIN Then 100 Debug.Print Tab(40); "Current LeftMargin="; prt.LeftMargin; " resetting to "; LEFT_MARGIN 110 prt.LeftMargin = LEFT_MARGIN 120 fSave = True 130 End If 140 If prt.RightMargin <> RIGHT_MARGIN Then 150 Debug.Print Tab(40); "Current RightMargin="; prt.RightMargin; " resetting to "; RIGHT_MARGIN 160 prt.RightMargin = RIGHT_MARGIN 170 fSave = True 180 End If 190 If prt.TopMargin <> TOP_MARGIN Then 200 Debug.Print Tab(40); "Current TopMargin="; prt.TopMargin; " resetting to "; TOP_MARGIN 210 prt.TopMargin = TOP_MARGIN 220 fSave = True 230 End If 240 If prt.BottomMargin <> BOTTOM_MARGIN Then 250 Debug.Print Tab(40); "Current BottomMargin="; prt.BottomMargin; " resetting to "; BOTTOM_MARGIN 260 prt.BottomMargin = BOTTOM_MARGIN 270 fSave = True 280 End If 290 If fSave Then 'Make a random change 300 Set rpt2 = Reports(strRptName).Report 310 With rpt2 320 If .DefaultView = 0 Then 330 .DefaultView = 1 340 Else 350 .DefaultView = 0 360 End If 'Set it back 370 If .DefaultView = 0 Then 380 .DefaultView = 1 390 Else 400 .DefaultView = 0 410 End If 420 End With 430 Set rpt2 = Nothing 440 Set Reports(strRptName).Report.Printer = prt 450 DoCmd.Close acReport, strRptName, acSaveYes 460 Debug.Print Tab(40); "Saved." 470 Else 480 DoCmd.Close acReport, strRptName, acSaveNo 490 End If 500 End If 510 Next rpt Error_Handler_Exit: 520 On Error Resume Next 530 Exit Sub Error_Handler: 540 MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: SetLetterMargins" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occured!" 550 Resume Error_Handler_Exit End Sub
Daniel Pineault, 2010-2016 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net
- Marked as answer by Bruce Hulsey Wednesday, March 15, 2017 10:47 PM
- Edited by Daniel Pineault (MVP)MVP Thursday, March 16, 2017 12:43 AM
Wednesday, March 15, 2017 10:37 PM -
Well, most of the time it's me. Nice to know that this time it's not!
I very much appreciate the time you took to test and figure this out. Thanks for your help Daniel!
-Bruce
Wednesday, March 15, 2017 10:46 PM