none
Set report margins using VBA RRS feed

  • 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



    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_Professionals

    Wednesday, 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



    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