access的papersize命令_[access报表]如何在access的报表中使用自定义纸张,及设置自定义纸张大小...

时　间:2007-10-18 21:42:45

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

正　文:

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

正 文：

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

报表打印如何用代码设定页面

Dim qdf As QueryDef

Dim ctlLabel As Control, ctlText As Control

Dim intDataX As Integer, intDataY As Integer

Dim intLabelX As Integer, intLabelY As Integer

Dim ncnt As Integer

Dim i As Integer

Dim ttlwidth As Double

Dim rptWaste As Report

Me.Painting = False

On Error Resume Next

Dim Dbs As Database, ctr As Container, doc As Document

Set Dbs = CurrentDb

ncnt = 0

Set rptWaste = CreateReport

Dbs.QueryDefs.Delete "www"

Set qdf = Dbs.CreateQueryDef("www", sql)

Dbs.QueryDefs.refresh

ttlwidth = 30

rptWaste.Section(acPageHeader).Height = 800

For i = 1 To 30 - 1

If Not (IsNull(adata(i)) or Trim(adata(i)) = "") Then

Set ctlText = CreateReportControl(rptWaste.name, acTextBox, , "", "", intDataX, intDataY)

Set ctlLabel = CreateReportControl(rptWaste.name, acLabel, acPageHeader, , "NewLabel", intLabelX, intLabelY)

ctlLabel.Caption = adata(i)

ctlText.Width = 1000

If adata(i) = "card_no" Then

ctlText.Width = 1200

ctlLabel.Caption = "卡号"

End If

If adata(i) = "date" Then

ctlText.Width = 1300

ctlLabel.Caption = &qu

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

Access源码网店