Access交流网
  • 设为首页|收藏本站|繁体中文|手机版
  •     
  • Access培训-Access开发平台-Access行业开发

  • 首页
  • 资讯
  • 技巧
  • 源码
  • 行业
  • 资源
  • 活动
  • 关于

技巧

ACCESS数据库

启动/设置/选项/背景

修复/压缩

安全/加密/解密

快捷键

版本升级/其它等

数据表

命名方式/设计规范

表设计

查询

Sql语言基础

选择查询

更新查询

删除查询

追加查询

生成表查询

交叉表查询

SQL特定查询

查询参数

查询综合应用

界面/窗体/控件

标签

文本框

命令按钮

组合框/列表框

选项组/复选框/选项按钮

选项卡

子窗体

窗体本身/综合应用

其它

报表打印

报表设计

高级报表

模块/函数/VBA/API/系统

VBA基础

内置函数

调试/跟踪/Debug

模块/类模块

API/COM/系统相关

字符数字日期

网络通信游戏

加密解密安全

文件处理

经典算法

宏/菜单/工具栏/功能区

宏/脚本

菜单/工具栏

功能区/Ribbon

图表/图形/图像/多媒体

图表

图形/图像

音频

视频/动画

DAO/链接表/ADO/ADP

DAO/链接表/ODBC

ADO/RDO

ADP

ActiveX/第三方控件/插件

Treeview树控件

ListView列表控件

Toolbar工具栏控件

微软其它控件

Dbi-Tech

CodeJock

Grid++Report

FastReport

ComponentOne

加载项/插件/Addin

OFFICE集成/导入导出/交互

Excel导入导出/交互

Word导入导出/交互

PPT交互

Outlook控制/邮件

Text文本文件/INI/CSV

PDF/SWF/XML格式

CAD格式

Sharepoint/其它Office

SqlServer/其它数据库

表

视图

存储过程/触发器

函数

用户/权限/安全

调试/维护

SqlServer其它/综合

发布/打包/文档/帮助

开发版/运行时

打包/发布/部署

开发文档/帮助制作

Access完整行业系统

采购管理系统

销售管理系统

仓库管理系统

人力资源管理HRM

CRM管理系统

MRP/ERP管理系统

BRP/流程优化

其它管理系统

心得/经验/绝招
其它/杂项
Excel技巧

Excel应用与操作

Excel开发编程

Word技巧

Word应用与操作

Word开发编程

Outlook技巧

Outlook应用与操作

Outlook开发编程

热门文章

  • 如何在报表中为每列加一条竖..
  • Access中窗体或者报表..
  • 如何在报表没有数据时,不打..
  • 如何使用代码控制报表的上下..
  • Access报表补空行代码
  • 如何在报表中每隔N行显示一..

最新文章

  • Access中窗体或者报表..
  • Access报表文本框按字..
  • Access报表打印设置
  • Access报表补空行代码
  • 懒人有懒计——浅谈自动报表
  • Access使用excel..

联系方式

Access交流网(免费Access交流)

QQ:18449932 

网  址:www.access-cn.com

当前位置:首页 > 技巧 > 报表打印
报表打印

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
发布人:网络文章  
分享到:
点击次数:  更新时间:2009-02-27 13:56:43  【打印此页】  【关闭】
上一条:ACCESS-VBA编程 第九章 VBA使用技巧1  下一条:ACCESS-VBA编程 第七章 SQL语法参考手册



相关文章

  • • Access中窗体或者报表页眉和页面页眉的区别,窗体页脚和页面页脚的区别
  • • Access报表文本框按字数同步缩放
  • • Access报表打印设置
  • • Access报表补空行代码
  • • 懒人有懒计——浅谈自动报表
  • • Access使用excel输出复杂报表
  • • 报表每页打印到一定行数自动分页
  • • 解决Access在页面设置中设置边距无法保存的问题

热门文章

  • [2003-12-06] 如何在报表中每隔N行显示一条粗线access数据库
  • [2003-12-06] access XP 里面怎么也查不到 line方法!access数据库
  • [2008-11-05] ACCESS和EXECL结合的简单说明access数据库
  • [2005-01-02] 如何使用代码控制报表的上下左右页边距?access数据库
  • [2005-04-08] 在Access 2002中打印报表的关系图access数据库
  • [2009-05-04] access输出资料到word用于打印access数据库

热门产品

公司动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图

Access交流网 版权所有 1999-2018 粤ICP备10043721号

QQ:18449932

Access应用 Access培训 Access开发 Access平台

access|数据库|access下载|access教程|access视频|access软件

Powered by MetInfo 5.3.12 ©2008-2023  www.metinfo.cn