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

时　间:2007-10-18 21:42:45
作　者:cuxun   ID：14  城市：长沙
摘　要:如何在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群 (群号:54525238) 　　　　　　Access源码网店