Type str_DEVMODE RGB As String * 94 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 Sub CheckCustomPage(ByVal rptName As String) ' 用 途:检查报表的自定义纸张 ' 调用方法:Call CheckCustomPage(rptName) ' 参数说明:rptName: 为检查的报表名称 ' 调用举例:设有名为"MyReport"的报表, ' Call CheckCustomPage("MyReport") ' 当该报表使用的是自定义纸张时,则显示自定义纸张的大小, ' 并询问是否更改纸张的大小并进行设置; ' 当该报表使用的是标准纸张时,则询问是否使用自定义纸张, ' 如果选择“是”,则要求输入纸张的大小并进行设置。
Dim DevString As str_DEVMODE Dim DM As type_DEVMODE Dim strDevModeExtra As String Dim rpt As Report Dim intResponse As Integer ' 在设计视图下打开报表 DoCmd.OpenReport rptName, acDesign
Set rpt = Reports(rptName) If Not IsNull(rpt.PrtDevMode) Then strDevModeExtra = rpt.PrtDevMode ' 获取当前的 DEVMODE 结构 DevString.RGB = strDevModeExtra LSet DM = DevString If DM.intPaperSize = 256 Then ' 显示用户自定义纸张的尺寸 intResponse = MsgBox("当前的自定义纸张为(mm):" & _ DM.intPaperWidth / 10 & " (宽) X " & _ DM.intPaperLength / 10 & " (长)。 你想改变吗?", _ vbYesNo + vbQuestion) Else ' 非自定义纸张 intResponse = MsgBox("报表没有使用自定义纸张。 " & _ "你想使用自定义纸张吗?", vbYesNo + vbQuestion) End If If intResponse = 6 Then ' 用户要改变纸张设置,初始化 DM 的各个域 DM.lngFields = DM.lngFields Or DM.intPaperSize Or DM.intPaperLength _ Or DM.intPaperWidth ' 设置为自定义纸张 DM.intPaperSize = 256
' 提示输入长度和宽度 DM.intPaperLength = InputBox("请输入纸张的长度(mm):") * 10 DM.intPaperWidth = InputBox("请输入纸张的宽度(mm):") * 10 ' 更新属性值 LSet DevString = DM Mid(strDevModeExtra, 1, 94) = DevString.RGB rpt.PrtDevMode = strDevModeExtra End If End If ' 关闭报表并保存 DoCmd.Close acReport, rptName, acSaveYes ' 预览报表 DoCmd.OpenReport rptName, acViewPreview End Sub
|