用VBA代码设置access报表的页面设置
时 间:2010/4/15 19:23:02
作 者:yiki
摘 要: 在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
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 '列宽
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