时　间:2009-05-08 08:39:23

作　者:摘　要:报表中使用自定义纸张,及设置自定义纸张大小

正　文:

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

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

Access软件网QQ交流群(群号:39785885)

Access源码网店