[access报表]报表中使用自定义纸张,及设置自定义纸张大小

时　间:2009-05-08 08:39:23
作　者:UMVSoft整理   ID：1445  城市：上海
摘　要:报表中使用自定义纸张,及设置自定义纸张大小
正　文:

报表中使用自定义纸张,及设置自定义纸张大小

Private Type str_DEVMODE
    RGB As String * 94
End Type
Private Type type_DEVMODE
    strDeviceName As String * 32
    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 * 32
    lngPad As Long
    lngBits As Long
    lngPW As Long
    lngPH As Long
    lngDFI As Long
    lngDFr As Long
End Type
' rptName: 为报表名称
Public Sub CheckCustomPage(ByVal rptName As String)
    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 = vbYes 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
    Set rpt = Nothing
End Sub