您的位置：　首页 > 技术文章 > Access数据库-模块/函数/VBA

VBA编程自动导出生成Excel表

来源:www.accessoft.com 点击数:34005 　 | 收藏 | 复制

时　间:2009-11-30 12:00:08
作　者:王樵民 ID：5203 城市：郑州
摘　要:利用一段VBA的程序代码，来自动完成根据需要而生成的Excel电子表功能。
正　文:

点击下载此附件VBA编程自动导出生成Excel表

利用这种方法就是要编制一段VBA的程序代码，来自动完成根据需要而生成的Excel电子表功能。

下面给出的是一个自定义的函数，该函数，可以将表或查询写入到Excel中，该函数的使用方法为：

变量= ZExcel(模板名, 文件名, 记录集, 起始行, 字段数)

其中：ZExcel是函数名，带5个参数，模板名为事先创建的Excel文件名，文件名是生成以后的Excel文件名，记录集：可以是表或查询，起始行表示从那一行开始写数据，字段数表示表或查询的字段数。

例：自动生成一个“客户年度欠款情况表”的Excel表。

先用Excel制作一个模板，比如“客户年度欠款情况表”的模板格式如表1所示：

表1客户年度欠款情况表模板

客户年度欠款情况表
客户	年度	合同额总计	付款金额总计	欠款金额总计	合同数

将该文件取名为“客户年度欠款情况表模板”，并保存成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行错误处理程序。