VB 程序设计
Access97的报表解决方案
利用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 下稍加修改就行了，所以采用此方法和用内部报表生成器设计所用的时间差不多。整个工作需要下面几步：
在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,
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 下就行了。
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 下稍加修改就行了，所以采用此方法和用内部报表生成器设计所用的时间差不多。整个工作需要下面几步：
在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,
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 下就行了。
话题作者
头衔:无
