VBA Code to set report print characteristics
Create a new module and paste the following:
Option Compare Database
Option Explicit
Type str_DEVMODE
RGB As String * 94
End Type
Type str_PRTMIP
strRGB As String * 28
End Type
Type type_PRTMIP
intLeftMargin As Integer
intTopMargin As Integer
intRightMargin As Integer
intBotMargin As Integer
intDataOnly As Integer
intWidth As Integer
intHeight As Integer
intDefaultSize As Integer
intColumns As Integer
intColumnSpacing As Integer
intRowSpacing As Integer
intItemLayout As Integer
intFastPrint As Integer
intDatasheet As Integer
End Type
Type type_DEVMODE
strDeviceName As String * 16
intSpecVersion As Integer
intDriverVersion As Integer
intSize As Integer
intDriverExtra As Integer
lngFields As Long
intOrientation As Integer
intPaperSize As Integer
intPaperLength As Integer
intPaperWidth As Integer
intScale As Integer
intCopies As Integer
intDefaultSource As Integer
intPrintQuality As Integer
intColor As Integer
intDuplex As Integer
intResolution As Integer
intTTOption As Integer
intCollate As Integer
strFormName As String * 16
lngPad As Long
lngBits As Long
lngPW As Long
lngPH As Long
lngDFI As Long
lngDFr As Long
End Type
Public Function CheckCustomPage(rptName As String, nPaperSize, nOrientation)
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
Dim rpt As Report
Dim PrtMipString As str_PRTMIP
Dim PM As type_PRTMIP
Dim intResponse As Integer
' Opens report in Design view.
Application.Echo False
DoCmd.OpenReport rptName, acDesign
Set rpt = Reports(rptName)
If Not IsNull(rpt.PrtDevMode) Then
strDevModeExtra = rpt.PrtDevMode ' Gets current DEVMODE structure.
DevString.RGB = strDevModeExtra
LSet DM = DevString
DM.lngFields = DM.lngFields Or DM.intPaperSize Or DM.intOrientation
DM.intPaperSize = nPaperSize ' Set custom page.
' Prompt for length and width.
If DM.intOrientation <> nOrientation Then
DM.intOrientation = nOrientation
End If
LSet DevString = DM ' Update property.
Mid(strDevModeExtra, 1, 94) = DevString.RGB
rpt.PrtDevMode = strDevModeExtra
End If
PrtMipString.strRGB = rpt.PrtMip
LSet PM = PrtMipString
PM.intLeftMargin = 0.166 ' Set margins.
PM.intTopMargin = 0.25
PM.intRightMargin = 0.166
PM.intBotMargin = 0.25
LSet PrtMipString = PM ' Update property.
rpt.PrtMip = PrtMipString.strRGB
DoCmd.Close acReport, rptName
Set rpt = Nothing
Application.Echo True
End Function
*************************************************
From the command button, Call the report thusly:
*************************************************
Dim RetVal As Variant
Dim rpt as String
Const DM_LEGAL = 5
Const DM_PORTRAIT = 1
Const DM_LANDSCAPE = 2
DoCmd.SetWarnings False
RetVal = CheckCustomPage(rpt, DM_LEGAL, DM_PORTRAIT)
DoCmd.SetWarnings True
DoCmd.OpenReport rpt, acViewPreview
