点击下载此附件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行错误处理程序。

具体可参考附件中的实例。