计算机世界1999年第1期

利用OLE自动化解决ACESS97中文版
报表生成器直线不能往下顺延的缺陷

总参通信工程设计研究院外五室 王 涛

　　ACCESS97 是 一 个 非 常 优 秀 的 数 据 库 软 件, 它 不 仅 能 充 当 办 公 自 动 化 的 桌 面 数 据 管 理 工 具, 也 是 一 个 开 发Client/Server 产 品 的 优 秀 前 端 开 发 工 具. 它 的 特 点 是 易 学 易 用、 工 具 丰 富、 不 需 写 大 量 代 码 就 可 以 在 很 短 的 时 间 内 开 发 出 界 面 优 美 且 功 能 强 大 的 系 统， 长 期 以 来 受 到 广 大 开 发 者 的 青 睐。 但 笔 者 在 使 用 时 发 现 其 报 表 生 成 器 中 有 一 个 明 显 不 适 合 我 国 国 情 的 缺 陷， 就 是 当 设 置 报 表DETAIL 节 上 的 字 段 长 度 因 为 横 向 空 间 不 够 而 设 为 自 动 向 下 顺 延（Can Grow 属 性 为True） 时， 如 果 字 段 旁 有 竖 线（ 国 内 大 部 分 公 文 报 表 都 有 竖 线， 而 国 外 则 很 少 有）， 则 竖 线 不 能 和 字 段 一 起 向 下 顺 延。 使 整 个 报 表 看 起 来 不 美 观。 这 个 缺 陷 在ACCESS2.0 和ACCESS97 中 文 版 上 都 有, 而 在FoxPro2.5B/3.0/5.0 下 却 没 有。 据 微 软 技 术 服 务 部 的 工 作 人 员 说 是 由 于 本 地 化 时 测 试 不 够 原 因 所 致。 为 此， 笔 者 在ACCESS 内 采 用 了OLE 自 动 化 方 法， 将ACCESS97 查 询 生 成 的 表 送 交EXCEL97 进 行 处 理（ 分 类 汇 总、 打 印、 预 演）， 较 好 地 解 决 了 这 个 问 题。 由 于ACCESS97 和EXCEL97 的VBA 在97 版 本 上 几 乎 完 全 兼 容， 在EXCEL97 下 录 制 的 宏 代 码 只 需 在ACCESS 下 稍 加 修 改 就 行 了， 所 以 采 用 此 方 法 和 用 内 部 报 表 生 成 器 设 计 所 用 的 时 间 差 不 多。 整 个 工 作 需 要 下 面 几 步：

　　1 ． 在EXCEL97 下 设 计 好 报 表 的 样 式， 包 括 表 头、 页 眉、 页 码 等， 对 需 要 自 动 翻 转 的 列， 在" 单 元 格 格 式 设 置" 下 设 为" 自 动 换 行"。

　　2 ． 在EXCEL97 下 录 制 好 当 数 据 送 入 后 进 行 的 操 作 宏（ 如 分 类 汇 总、 加 边 框 线， 加 空 行、 打 印 输 出、 预 演 等 动 作）。

　　3 ． 在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,

TotalList:=Array(6, 9, 10, _

11, 12, 13, 14, 15, 16),

Replace:=True, PageBreaks:=False, _

SummaryBelowData:=False

Else

.Subtotal GroupBy:=2, Function:=-4157,

TotalList:=Array(6, 9, 10, _

11, 12, 13, 14, 15, 16),

Replace:=True, PageBreaks:=False, _

SummaryBelowData:=True

End If

End With

'根据用户的选择设置页眉和页尾。

With xlsheetobj.PageSetup

.LeftHeader = "" & Chr(10) & "" & Chr(10) & "

" & Mid(Me![Cmbo单位], 4)

.CenterHeader = "&""宋体,加粗""&18 " &

Me![Cmbo年度] & "年" & Mid(Me![Cmbo类别], 4) & "XXX表"

End With

xlsheetobj.Range("A1").Select

'将空行内容清掉

k = Val(Me![Comb空行])

If Val(Me![Comb空行]) > 0 Then

Dim content As String

i = 5

content = xlsheetobj.cells(i, 2).formulaR1C1

Do While InStr(1, content, "空行空行空行") = 0

i = i + 1

content = xlsheetobj.cells(i, 2).formulaR1C1

Loop

xlsheetobj.Range("B" & Trim(Str(i - k + 5))

& ":" & "Q" & Trim(Str(i + 5))).Select

xlobj.Selection.ClearContents

xlsheetobj.Range("A1").Select

End If



Else '不更新

xlsheetobj.Activate

End If

xlobj.ActiveWindow.SelectedSheets.PrintPreview '预演报表

'如为打印：xlobj.ActiveWindow.SelectedSheets.PrintOut

DoCmd.Hourglass False '恢复鼠标形状

xlobj.Visible = True '让EXCEL可见

清除对象变量空间，节省内存

Set dbs = Nothing

Set xlobj = Nothing

xlobj.quit '关闭EXCEL

Exit Sub

ErrorHandler: '出错处理

DoCmd.Hourglass False

MsgBox "Error number " & Err.Number & ": " & Err.Description

' Resume with statement following occurrence of error.

Resume Next

End Sub




通 过 这 个 例 子 我 们 看 到 在OFFICE97 下 利 用OLE 自 动 化 扩 展 应 用 程 序 的 功 能 是 多 么 方 便 和 强 大。 用EXCEL 完 成 的 报 表 的 优 点 是 格 式 美 观, 修 改 方 便. 缺 点 是 第 一 次 生 成EXCEL 表 格 时 速 度 较 慢.

　　本 例 是 用EXCEL 对 数 据 进 行 报 表 操 作, 其 实 也 可 参 照 此 例 的 方 法 在EXCEL 上 建 立 图 形 统 计、 财 务 分 析、 数 据 透 视 表 分 析 等 应 用 程 序， 只 要 在EXCEL 下 录 制 相 应 的 宏， 再 加 到ACCESS 下 就 行 了。