用VBA代码设置access报表的页面设置

来源:http://www.yikisoft.cn/WZ.asp?id=43 点击数:19797 　 | 收藏 | 复制

时　间:2010-04-15 19:23:02
作　者:yiki ID：8708 城市：淮安
摘　要: 在ACCESS中，报表的页面设置通常通过菜单［页面设置］命令即可完成。可是，比较复杂的页面设置往往容易丢失，特别是当我们将MDB编译为MDE后分发给用户时，如果需要对子报表进行分列设置，则用户将无法操作。所以我们在编译时总是要检查子报表的页面设置是否正确。
正　文:

一、问题提出

在ACCESS中，报表的页面设置通常通过菜单［页面设置］命令即可完成。可是，比较复杂的页面设置往往容易丢失，特别是当我们将MDB编译为MDE后分发给用户时，如果需要对子报表进行分列设置，则用户将无法操作。所以我们在编译时总是要检查子报表的页面设置是否正确。

如图，在主报表里嵌套着子报表，而子报表是分为8列的，所以必须设置子报表的页面属性为8列，但分发给用户的程序不含直接打开的子报表。

在ACCESS中，象这样的设置给终端用户的带来不便，也降低了程序的便捷性。所以考虑用代码实现。

二、程序代码

1、建立公用模块，代码如下：

Option Compare Database

Type str_PRTMIP
    strRGB As String * 28
End Type
Type type_PRTMIP
    xLeftMargin As Long
    yTopMargin As Long
    xRightMargin As Long
    yBotMargin As Long
    fDataOnly As Long
    xWidth As Long
    yHeight As Long
    fDefaultSize As Long
    cxColumns As Long
    yColumnSpacing As Long
    xRowSpacing As Long
    rItemLayout As Long
    fFastPrint As Long
    fDatasheet As Long

End Type

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

Sub Setprint_zi(strName, fx, sbj, xbj, zbj, ybj, lie, liewith)
'-----------------------------------------------------------------------------------------
'名称：设置子报表页面
'说明：设置后不打开
'作者：郭兆良
'日期：2010.4.20
'参数：strName报表名称,fx方向,sbj上边距,xbj下边距,zbj左边距,ybj右边距,lie列数,liewith列间距
'------------------------------------------------------------------------------------------
On Error GoTo err1
    Const DM_PORTRAIT = 1
    Const DM_LANDSCAPE = 2
    Dim DevString As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim PrtMipString As str_PRTMIP
    Dim PM As type_PRTMIP
    Dim strDevModeExtra As String
    Dim rpt As Report

    DoCmd.OpenReport strName, acDesign
    Set rpt = Reports(strName)
    PrtMipString.strRGB = rpt.PrtMip
    LSet PM = PrtMipString
    PM.yTopMargin = sbj * 56.736    ' 设置上边距。
    PM.yBotMargin = xbj * 56.736    ' 设置下边距。
    PM.xLeftMargin = zbj * 56.736   ' 设置左边距。
    PM.xRightMargin = ybj * 56.736 ' 设置右边距。
    PM.cxColumns = lie              ' 列
    PM.xRowSpacing = 0         '行间距
    PM.yColumnSpacing = 0      '列间距
    PM.xWidth = liewith * 567.36    '列宽
    'PM.fDataOnly = True                    '只打印数据
    'PM.fDatasheet
    'PM.fDefaultSize
    'PM.fFastPrint
    'PM.yHeight                '列高
    'PM.rItemLayout = 1953

    LSet PrtMipString = PM            ' 更新属性。
    rpt.PrtMip = PrtMipString.strRGB
    If Not IsNull(rpt.PrtDevMode) Then
        strDevModeExtra = rpt.PrtDevMode
        DevString.RGB = strDevModeExtra
        LSet DM = DevString
        DM.lngFields = DM.lngFields or _
                       DM.intOrientation    ' Initialize fields.
        If fx = 1 Then
            DM.intOrientation = DM_PORTRAIT    '设置纵向打印
        Else
            DM.intOrientation = DM_LANDSCAPE    '设置横向打印
        End If
        LSet DevString = DM            ' Update property.
        Mid(strDevModeExtra, 1, 94) = DevString.RGB
        rpt.PrtDevMode = strDevModeExtra
    End If
    DoCmd.close acReport, strName, acSaveYes
    Set rpt = Nothing
err1:
End Sub

Sub Setprint(strName, fx, sbj, xbj, zbj, ybj, lie, liewith)
'-----------------------------------------------------------------------------------------
'名称：设置报表页面
'说明：设置后打开
'作者：郭兆良
'日期：2010.4.20
'参数：strName报表名称,fx方向,sbj上边距,xbj下边距,zbj左边距,ybj右边距,lie列数,liewith列间距
'------------------------------------------------------------------------------------------
On Error GoTo err1
    Const DM_PORTRAIT = 1
    Const DM_LANDSCAPE = 2
    Dim DevString As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim PrtMipString As str_PRTMIP
    Dim PM As type_PRTMIP
    Dim strDevModeExtra As String
    Dim rpt As Report

    LSet PrtMipString = PM            ' 更新属性。
    rpt.PrtMip = PrtMipString.strRGB
    If Not IsNull(rpt.PrtDevMode) Then
        strDevModeExtra = rpt.PrtDevMode
        DevString.RGB = strDevModeExtra
        LSet DM = DevString
        DM.lngFields = DM.lngFields or _
                       DM.intOrientation    ' Initialize fields.
        If fx = 1 Then
            DM.intOrientation = DM_PORTRAIT    '设置纵向打印
        Else
            DM.intOrientation = DM_LANDSCAPE    '设置横向打印
        End If
        LSet DevString = DM            ' Update property.
        Mid(strDevModeExtra, 1, 94) = DevString.RGB
        rpt.PrtDevMode = strDevModeExtra
    End If
    DoCmd.OpenReport strName, acViewPreview
    Set rpt = Nothing
err1:
End Sub

2、窗体模块引用

当我们打印报表或预览报表时加入以下引用：

(1)含子报表的报表

    sub print()
    DoCmd.Hourglass True
    Call Setprint_zi("子报表", 1, 0, 0, 0, 0, 8, 2.1)
    DoCmd.Hourglass False
    stDocName = "报表名"
    DoCmd.OpenReport stDocName, acPreview
    end sub

以上引用可以实现对子报表的页面设置。

(2)不含子报表的报表

    sub print()
    call Setprint("报表名",1, 24, 24, 24, 24, 列数, 列宽CM数)
    end sub

    1表示纵向，2表示横向
    24为上、下、左、右边距均为24MM
    列数根据需要设置，整数
    列宽设置为CM数

三、总结

此方法参考了网络有关PRTMIP属性的文章，大部分代码来自网络。只是在列设置上我作了些改动。此问题曾在ACCESSSOFT网站求教数日，无人应答，想必遇到此类需求的人不多，或关注度不够。今天得以解决，所以公布为大家共享。

本文来自：一启软件研习工作室
网站地址：http://www.yikisoft.cn
文章出处：http://www.yikisoft.cn/WZ.asp?id=43

Access软件网QQ交流学习群群号:41208985

Access软件网官方交流QQ群 (群号:54525238) 　　　　　　Access源码网店

【打印此文】【关闭窗口】