access-VBA编程 第八章 报表

如果您想判断一个数据库中的报表是否打开，您需要检查报表连接，如下函数可以做到。
如果返回true,则报表是打开，false则报表没有打开。
Sub fCheckReport(strReport As String) As Boolean
Dim rpt As Report
fCheckReport=False
For Each rpt In Reports
If rpt.Name=strReportName Then fCheckReport=True
Next rpt
End Function
打印当前窗体上的记录的报表
DoCmd.OpenReport "rptName", acViewNormal, , "[UniqueFieldOnReport]=Forms![frmName]![UniqueFieldOnReport]"
全部范围内,从第二张打到第五张,高品质打印,印三份
DoCmd.PrintOut acPrintAll, 2, 5, acHigh, 3, False
生成间隔背景颜色的报表
要求:生成间隔背景颜色的报表，奇数行的背景颜色为兰色,偶数行的背景颜色为白色,兰白相间,方便查看.
方法:根据行号进行判定,设定背景色.
1 设计报表INVOICE ,必须有行号字段NO(由1开始连续的系列号)
2 设计宏SETINVOICECOLOR,条件及操作如下
条件 ([Reports]![INVOICE]![NO]) Mod 2=1
操作 Setvalue
项目 [Reports]![INVOICE].[Section](0).[BackColor]
表达式1632256
条件 ([Reports]![INVOICE]![NO]) Mod 2=0
操作 Setvalue
项目 [Reports]![INVOICE].[Section](0).[BackColor]
表达式16777215
3 设计报表INVOICE ,选定节Detail的属性中,事件"打印"为宏 SETINVOICECOLOR.
4 打印报表INVOICE,生成间隔背景颜色的报表.
报表奇偶页不同颜色显示
Option Compare Database
Option Explicit
Dim i As Integer
Private Sub 主体_Format(Cancel As Integer, FormatCount As Integer)
i = i + 1
If i Mod 2 = 0 Then
Me.主体.BackColor = 12632256
Else
Me.主体.BackColor = 16777215
End If
End Sub
如何在报表中产生递增的顺序编号
在报表的细节上放一个文本框，控件源等于=1 并设"运行总和"属性设置为“工作组之上”即可。
给输出的报表加个边框
Private Sub Report_Page()
Line (0, 0)-(ScaleWidth, ScaleHeight), , B
End Sub
报表页小计
在报表的主体节复制、粘贴一个要统计的数据的文本框TEXT1，属性的数据----运行总和为“全部之上”，可见性可设为“否”；
在页脚建一未绑定文本框TEXT2，用来显示页合计数据值；
在报表的页脚的打印事件中写：
Dim x As Single
Me.TEXT2 = TEXT1 - x
x = TEXT1
实际上是每个记录的工资累计。每页结束后把这个值赋给X，下页再合计后减去X就是本页合计，以此类推。
每页固定打印7行，数据不足时用空行补齐。
最好还是用Line语句。在报表的“打印页前”事件中输入下面内容。
Private Sub Report_Page()
Dim rpt As Report, lngColor As Long
Dim i As Integer
Set rpt = Reports!当前报表
rpt.ScaleMode = 7
lngColor = RGB(255, 0, 0)
rpt.Line (2.503, 2.5)-(4.735, 6.588), lngColor, B
rpt.Line (7.354, 2.5)-(9.074, 6.588), lngColor, B
rpt.Line (10.317, 2.5)-(12.037, 6.588), lngColor, B
rpt.Line (13.81, 2.5)-(15.952, 6.588), lngColor, B
rpt.Line (19.123, 2.5)-(19.123, 6.588), lngColor
For i = 1 To 7
rpt.Line (0.4, 2.5 + (i - 1) * 0.584)-(19.123, 2.5 + i * 0.584), lngColor, B
Next i
End Sub
应用筛选打印报表以及取消后
Sub 打印发货单_Click()
' 这段代码由“命令按钮向导”创建。
On Error GoTo Err_PrintInvoice_Click
Dim strDocName As String
strDocName = "发货单"
' 打印“发货单”报表，使用“发货单筛选”查询打印当前订单的发货单。
DoCmd.OpenReport strDocName, acViewNormal, "发货单筛选"
Exit_PrintInvoice_Click:
Exit Sub
Err_PrintInvoice_Click:
' 如果用户取消操作，不显示错误消息。
Const conErrDoCmdCancelled = 2501
If (Err = conErrDoCmdCancelled) Then
Resume Exit_PrintInvoice_Click
Else
MsgBox Err.Description
Resume Exit_PrintInvoice_Click
End If
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 = "日期"
End If
If adata(i) = "op_name" Then
ctlText.Width = 1300
ctlLabel.Caption = "工序号"
End If
If adata(i) = "class_name" Then
ctlText.Width = 1300
ctlLabel.Caption = "产品类型"
End If
If adata(i) = "dept_code" Then
ctlText.Width = 1000
ctlLabel.Caption = "车间代码"
End If
If adata(i) = "totalwaste_qty" Then
ctlText.Width = 1000
ctlLabel.Caption = "废品总重"
End If
' End If
ctlLabel.Width = ctlText.Width
ctlText.ControlSource = adata(i)
ctlText.BorderStyle = 1
ctlLabel.BorderStyle = 1
ctlText.Left = ttlwidth
ctlLabel.Left = ttlwidth
ctlLabel.Top = 800 - ctlLabel.Height
ctlLabel.FontBold = True
ttlwidth = ttlwidth + ctlText.Width
End If
Next i
rptWaste.RecordSource = "www"
rptWaste.Section(acDetail).Height = ctlText.Height
Set ctlLabel = CreateReportControl(rptWaste.name, acLabel, acPageHeader, , "NewLabel", intLabelX, intLabelY)
ctlLabel.Top = 0
ctlLabel.Caption = Trim(txtDepartment.value) & "废品统计报表"
ctlLabel.TextAlign = 2
ctlLabel.FontSize = 16
ctlLabel.FontBold = True
ctlLabel.Width = 4000
ctlLabel.Height = 500
ctlLabel.Left = (rptWaste.Width - ctlLabel.Width) / 2
Const DM_PORTRAIT = 1
Const DM_LANDSCAPE = 2
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
If Not IsNull(rptWaste.PrtDevMode) Then
strDevModeExtra = rptWaste.PrtDevMode
DevString.RGB = strDevModeExtra
'Else
LSet DM = DevString
DM.lngFields = DM.lngFields or DM.intOrientation ' Initialize fields.
'If DM.intOrientation = DM_PORTRAIT Then
DM.intOrientation = DM_LANDSCAPE
' DM.intOrientation = DM_PORTRAIT
'End If
LSet DevString = DM ' Update property.
Mid(strDevModeExtra, 1, 94) = DevString.RGB
rptWaste.PrtDevMode = strDevModeExtra
End If
DoCmd.DeleteObject acReport, "rptwaste_tmp"
DoCmd.Save , "rptwaste_tmp"
DoCmd.Close acReport, "rptwaste_tmp", acSaveNo
' For i = 0 To FORMs.Count - 1
' FORMs(i).Visible = False
' Next
DoCmd.OpenReport "rptwaste_tmp", acViewPreview
Me.Painting = True
报表中使用自定义纸张,及设置自定义纸张大小
正 文：
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

上一节 下一节