|
|||||||||||||||||||||||||||||||||||||||||||||||||
将该文件取名为“客户年度欠款情况表模板”，并保存成Excel97-Excel2003兼容的文件格式。 使用下面的语句就可以自动生成一个“客户年度欠款情况表”的Excel电子表。
d = ZExcel("客户年度欠款情况表模板", "客户年度欠款情况表", "客户按年度计算欠款情况", 3, 6) 例：自动生成一个“客户月份欠款情况表”的Excel表。 先用Excel制作一个模板，比如“客户月份欠款情况表”的模板格式如表2所示：
表2客户月份欠款情况表模板
将该文件取名为“客户月份欠款情况表模板”，并保存成Excel97-Excel2003兼容的文件格式。 使用下面的语句就可以自动生成一个“客户月份欠款情况表”的Excel电子表。
d = ZExcel("客户月份欠款情况表模板", "客户月份欠款情况表", "客户按月计算欠款情况", 3, 6)
有了这个函数，将数据库中的数据输出到Excel电子表中就方便多了。其他需要生成的表格采用类似的方法，先创建一个模板，然后调用函数ZExcel即可。
下面就是该函数：
1 '将一个表或查询产生的记录集写入Excel表中
2 Function ZExcel(模板名, 文件名, 记录集, 起始行, 字段数, Optional 条件 As String)
3 Dim Excel1 As Object ' 定义引用 Microsoft Excel 的变量。
4 Dim dbs As Database
5 Dim rst As Recordset
6 Dim I, I1 As Integer
7 Dim WJ1, WJ2, s As String
8 'On Error GoTo err1
9 Set dbs = CurrentDb
10 If InStr(1, UCase(模板名), ".XLS") > 0 or InStr(1, UCase(模板名), ".XLSX") > 0 Then '有扩展名
11 WJ1 = CurrentProject.Path & "\" & 模板名
'模板文件名 （CurrentProject.Path为当前数据库的路径）
12 Else
13 WJ1 = CurrentProject.Path & "\" & 模板名 & ".XLS"
'模板文件名 （CurrentProject.Path为当前数据库的路径）
14 End If
15 If InStr(1, UCase(文件名), ".XLS") > 0 or InStr(1, UCase(文件名), ".XLSX") > 0 Then '有扩展名
16 WJ2 = CurrentProject.Path & "\" & 文件名 '目标文件名
17 Else
18 WJ2 = CurrentProject.Path & "\" & 文件名 & ".XLS" '目标文件名
19 End If
20 FileCopy WJ1, WJ2 '拷贝文件（模板文件拷贝成目标文件）
21 Set Excel1 = GetObject(WJ2, "Excel.Sheet") '建立与Excel的连接变量
22 Excel1.Application.Visible = False '不打开Excel程序
23 Excel1.Parent.Windows(1).Visible = True '可见属性为真
24 If Nz(条件) <> "" Then 记录集 = "select * from " & 记录集 & " where " & 条件
25 Set rst = dbs.OpenRecordset(记录集, 2) '设置记录集
26 If Not rst.EOF Then rst.MoveFirst '记录集头部
27 If Not rst.EOF Then rst.MoveNext '记录集下移一条记录
28 If Not rst.EOF Then rst.MoveNext '记录集下移一条记录
29 s = Mid(Str(起始行 + 1), 2) & ":" & Mid(Str(起始行 + 1), 2)
30 While Not rst.EOF '判断记录集是否结束
31 Excel1.Application.Rows(s).Select '选择Excel的行
32 Excel1.Application.Selection.Insert '插入行
33 rst.MoveNext '记录集下移一条记录
34 Wend '循环结束语句
35 If Not rst.EOF Then rst.MoveFirst '记录集头部
36 I1 = 起始行 'Excel的行
37 While Not rst.EOF '判断记录集是否结束
38 For I = 1 To 字段数 '按字段数循环
39 Excel1.Application.Cells(I1, I).Value = rst.Fields(I - 1) '在Excel列中填写数据
40 Next I '循环结束语句
41 rst.MoveNext '记录集下移一条记录
42 I1 = I1 + 1 '行加1
43 Wend '循环结束语句
44 Excel1.Save '保存Excel
45 Excel1.Application.Quit '关闭Excel
46 Set Excel1 = Nothing '清除内存变量
47 Set dbs = Nothing
48 Set rst = Nothing
49 ZExcel = True
50 Exit Function
51 err1:
52 Set Excel1 = Nothing
53 Set dbs = Nothing
54 Set rst = Nothing
55 ZExcel = False
56 End Function
函数前边的号码是行号，函数本身并没有，是笔者为说明而加的。
Function ZExcel(模板名, 文件名, 记录集, 起始行, 字段数, Optional 条件 As String)
函数的第1行是函数的名称定义及所带参数，函数名为ZExcel，所带参数6个，其中前5个参数是必选参数，最后一个条件参数是可选参数。 10-19行使判断模板名和文件名中是否含有“.XLS”，如果不含就加上；20行利用模板复制一个新文件；30-34行根据记录集的记录数加入空行；35-43行将记录集中的数据写入到Excel中；44行保存Excel；45行关闭Excel；46-48行清除内存变量；49行函数赋值为真；51-55行错误处理程序。 具体可参考附件中的实例。 |
|||||||||||||||||||||||||||||||||||||||||||||||||
点击下载此附件