Access VBA Printer Setting - acPRPSUser

Question

I have a Label printer and depending on the computer opening the label report, I need to make sure that the print setting are always the same when it opens.

I have been able to set the margins, dataonly, itemsize/width, but for the life of me I cannot figure out how to set .PaperSize = to a custom papersize.

I have gone through quite a few docs including the MSDN - https://learn.microsoft.com/en-us/previous-versions/office/developer/office-xp/aa139946(v=office.10)?redirectedfrom=MSDN

I can find the setting for a user defined paper size but how do I actually set it?

Public Sub subLabelMargins(strReport)
Const LEFT_MARGIN         As Long = 144 '.1
Const RIGHT_MARGIN        As Long = 0   '0
Const TOP_MARGIN          As Long = 144 '.1
Const BOTTOM_MARGIN       As Long = 0   '0

Dim prt As Printer
Dim rpt As AccessObject
Dim rpt2 As Access.Report
'Dim strRptName As String
Dim fSave As Boolean

On Error GoTo Error_Handler

If strReport Like "lbl*" Then
    DoCmd.OpenReport strReport, acDesign, , , acHidden

    fSave = False

    Set prt = Reports(strReport).Report.Printer

    Debug.Print strReport;
    
    'Margins
    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
    
    'Label Size to fit within Margin
    With prt
        .DataOnly = True
        .DefaultSize = False
        .ItemSizeHeight = 2448
        .ItemSizeWidth = 5328
        '.PaperSize = "My Custom Paper-4x2"
        '.PaperSize = 149
        .PaperSize = acPRPSUser
    End With
    
    'Paper Selection
    '
    
    If fSave Then
        'Make a change since access doesn't notice a difference to save with just margin change
        Set rpt2 = Reports(strReport).Report
         
        With rpt2
            If .DefaultView = 0 Then
                .DefaultView = 1
            Else
                .DefaultView = 0
            End If
            'Set it back
            If .DefaultView = 0 Then
                .DefaultView = 1
            Else
                .DefaultView = 0
            End If
        End With
         
        Set rpt2 = Nothing

        Set Reports(strReport).Report.Printer = prt
        DoCmd.Close acReport, strReport, acSaveYes
        Debug.Print Tab(40); "Saved."
    Else
        DoCmd.Close acReport, strReport, acSaveNo
    End If
End If

Error_Handler_Exit:

On Error Resume Next

Exit Sub

Error_Handler:

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!"
Resume Error_Handler_Exit

End Sub

Access VBA Printer Setting - acPRPSUser

0 Answers