如果您想判断一个数据库中的报表是否打开，您需要检查报表连接，如下函数可以做到。 如果返回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
