利用OLE自动化解决ACESS97中文版报表生成器直线…
2008-02-23 06:53:59来源:互联网 阅读 ()
方法,将ACCESS97 查询生成的表送交EXCEL97 进行处理(分类汇总、打印、预演),较好地解决了这个问题。由于ACCESS97 和EXCEL97 的VBA 在97 版本上几乎完全兼容,在EXCEL97 下录制的宏代码只需在ACCESS 下稍加修改就行了,所以采用此方法和用内部报表生成器设计所用的时间差不多。整个工作需要下面几步:
在EXCEL97 下设计好报表的样式,包括表头、页眉、页码等,对需要自动翻转的列,在" 单元格格式设置" 下设为" 自动换行"。
在EXCEL97 下录制好当数据送入后进行的操作宏(如分类汇总、加边框线,加空行、打印输出、预演等动作)。
在ACCESS 下用VBA 语句和DAO 对象的方法将数据送入EXCEL 表内,并将EXCEL 下宏操作变成ACCESS 下的语句。
以下是ACCESS97 下的程序代码,实际应用程序界面是一个对话框屏幕(FORM), 上面有五个下拉框(Comb_) 和一个文字框(Text), 由用户选择相应的信息,然后用户按" 确定" 命令按钮执行程序。其中有些属性和方法在ACCESS2.0 下不能使用, 可采用相应的语句.
Private Sub 确认_Click()
On Error GoTo ErrorHandler
Dim stDocName As String
Dim k As Integer
stDocName = "Pqry_YEAR"
DoCmd.OpenQuery stDocName ' 从原始表内根据用户输入的信息条件运行" 生成表查询", 生成一个供打印用的表.
' 增加空记录处理-- 为了保证记录数少时也打印整张表.
If Val(Me![Comb 空行]) > 0 Then ' 如果用户输入了大于0 的数值, 表示加空行
For k = 1 To Val(Me![Comb 空行])
CurrentDb.Execute "INSERT INTO Pqry_YEAR
( 项目类) VALUES (' 空行空行空行');"
Next k
End If
Dim msgVar As Integer
' 定义EXCEL 对象变量
'------------------------------
Dim xlobj As Object
Dim xlsheetobj As Object
Dim xlrange As Object
'------------------------------
' 定义ACESS 记录集对象变量
Dim dbs As Database, rst As Recordset
Dim strSQL As String
Dim recTotal, fieldTotal As Integer ' recTotal:
表示该表内记录总数;
fieldTotal 表示字段总数
Dim i, j As Integer
i = 0
j = 0
' Return reference to current database.
Set dbs = CurrentDb ' 当前数据库
Set rst = dbs.OpenRecordset("Pqry_YEAR ") ' 选择记录集
recTotal = rst.RecordCount ' 得出记录数
fieldTotal = rst.Fields.Count ' 得出字段数
'----------------------------------
' 建立EXCEL 对象
Set xlobj = CreateObject("Excel.Application.8")
' 打开设计好的EXCEL 表--REPORT.XLS
xlobj.Workbooks.Open FileName:=pPathname & " REPORT.xls"
Set xlsheetobj = xlobj.ActiveWorkbook.Worksheets("REPORT ")
' 指向工作表
' 如果是改动过的表, 不再打开
If MsgBox(" 当前打印表格文件中已有数据,
是否需要更新?"
& Chr(13) & _
" 提示: 只有对数据进行改动后, 才需要更新.", 68)
= vbYes Then
DoCmd.Hourglass True ' 由于时间较长,
将鼠标设为沙漏形状
xlsheetobj.Rows("5:200").Select ' 选定区域
xlobj.Selection.Delete Shift:=-4162 '
注意! 原录制宏中-4162 为xlnone, 是EXCEL97 的常量, 但在ACCESS 下却不认, 只能到EXCEL 下的对象浏览器去查询对应的常数.
' 开始向EXCEL 传送数据
Do Until rst.EOF
For j = 1 To fieldTotal
xlsheetobj.cells(5 i, j).Value = rst.Fields(j - 1)
Next j
rst.MoveNext
i = i 1
Loop
rst.Close
'在EXCEL中调整,具体常数参见EXCEL下的对象浏览器
xlsheetobj.Range("A4:Q" & Trim(Str(recTotal 4))).
Select ' 选定范围
'以下为设置边框线录制的宏代码,已删除了相似的语句.
xlobj.Selection.Borders(5).LineStyle = -4142
xlobj.Selection.Borders(6).LineStyle = -4142
With xlobj.Selection.Borders(7)
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With xlobj.Selection
' 确定是合计在表上还是在表尾
If Me![Fram 位置] = 1 Then
.Subtotal GrouPBy:=2, Function:=-4157,
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
上一篇:在VB中实现位图的透明放置
下一篇:在VB里巧用数据类型集合
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash