两种输出方法随便选：
| Function export_word_use_range()
'请先引用 word Dim objWord As New Word.Application Dim ragRange As Range Dim Ils1 As InlineShape objWord.Documents.add objWord.WindowState = wdWindowStateMaximize objWord.Visible = True objWord.ActiveDocument.PageSetup.LeftMargin = 30 objWord.ActiveDocument.PageSetup.RightMargin = 30 Set ragRange = objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBefore "标题" ragRange.Font.Bold = True ragRange.Font.Size = 22 ragRange.ParagraphFormat.Alignment = wdAlignParagraphCenter '引用ado Dim Rs As New ADODB.Recordset Rs.Open "select * from temp order by 课程名称,类型名称,临时编号", CurrentProject.Connection, 1, 1 If Rs.EOF And Rs.BOF Then MsgBox "没有任何记录" Exit Function End If Set ragRange = Nothing Dim strType As String Dim lngNO As Long Dim lngTopicNo As Long LoadTopicNo Do Until Rs.EOF If strType <> Rs("类型名称") Then lngTopicNo = lngTopicNo + 1 Set ragRange = objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBefore strTopicNo(lngTopicNo) & "、" & Rs("类型名称") & "：" ragRange.InsertBefore vbCrLf ragRange.Bold = True ragRange.Font.Size = 15 strType = Rs("类型名称") lngNO = 0 End If lngNO = lngNO + 1 Set ragRange = objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBefore Str(lngNO) & ". " & Nz(Rs("试题内容"), "") ragRange.Bold = False ragRange.Font.Size = 10 If Len(Nz(Rs("图形"), "")) > 0 Then Set Ils1 = objWord.ActiveDocument.InlineShapes.AddPicture(filename:= _ Rs("图形"), _ LinkTofile:=False, SaveWithDocument:=True) End If Set ragRange = objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBefore Chr(9) & "第 " & Str(lngNO) & ". 题答案： " & Nz(Rs("试题答案"), "") ragRange.Bold = False ragRange.Font.Size = 10 ragRange.Font.Color = wdColorLightBlue Rs.MoveNext Loop Rs.Close Set ragRange = objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertAfter "试卷生成日期：" & FormatDateTime(Now, vbLongDate) & " " & FormatDateTime(Now, vbLongTime) ragRange.Font.Bold = False ragRange.Font.Size = 10 ragRange.ParagraphFormat.Alignment = wdAlignParagraphRight End Function |
| Function export_word_use_selection()
'请先引用 word Dim objWord As New Word.Application Dim Slt1 As Selection Dim Ils1 As InlineShape objWord.Documents.add objWord.WindowState = wdWindowStateMaximize objWord.Visible = True objWord.ActiveDocument.PageSetup.LeftMargin = 30 objWord.ActiveDocument.PageSetup.RightMargin = 30 Set Slt1 = objWord.ActiveWindow.Selection Slt1.Font.Size = 22 Slt1.Font.Bold = True Slt1.ParagraphFormat.Alignment = wdAlignParagraphCenter Slt1.InsertBefore "标题" & vbCrLf Slt1.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove '引用ado Dim Rs As New ADODB.Recordset Rs.Open "select * from temp order by 课程名称,类型名称,临时编号", CurrentProject.Connection, 1, 1 If Rs.EOF And Rs.BOF Then MsgBox "没有任何记录" Exit Function End If Dim strType As String Dim lngNO As Long Dim lngTopicNo As Long LoadTopicNo Do Until Rs.EOF If strType <> Rs("类型名称") Then lngTopicNo = lngTopicNo + 1 Slt1.Font.Bold = True Slt1.Font.Size = 15 Slt1.ParagraphFormat.Alignment = wdAlignParagraphThaiJustify Slt1.InsertBefore strTopicNo(lngTopicNo) & "、" & Rs("类型名称") & "：" & vbCrLf Slt1.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove strType = Rs("类型名称") lngNO = 0 End If lngNO = lngNO + 1 Slt1.Font.Bold = False Slt1.Font.Size = 10 Slt1.InsertBefore Chr(9) & Str(lngNO) & ". " & Nz(Rs("试题内容"), "") & vbCrLf Slt1.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove If Len(Nz(Rs("图形"), "")) > 0 Then Slt1.InlineShapes.AddPicture filename:=Rs("图形"), LinkTofile:=False, SaveWithDocument:=True Slt1.InsertBefore vbCrLf Slt1.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove End If Slt1.Font.Bold = False Slt1.Font.Size = 10 Slt1.Font.Color = wdColorLightBlue Slt1.InsertBefore Chr(9) & Chr(9) & "第 " & Str(lngNO) & ". 题答案： " & Nz(Rs("试题答案"), "") & vbCrLf Slt1.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove Slt1.Font.Color = wdColorAutomatic Rs.MoveNext Loop Rs.Close Slt1.InsertBefore vbCrLf Slt1.InsertBefore vbCrLf Slt1.InsertAfter "试卷生成日期：" & FormatDateTime(Now, vbLongDate) & " " & FormatDateTime(Now, vbLongTime) Slt1.Font.Bold = False Slt1.Font.Size = 10 Slt1.ParagraphFormat.Alignment = wdAlignParagraphRight End Function |
转自Aaccess911
还有一个例子，比较详细：
在Access中应用ADO将数据输出到Word1. 系统配置 系统软件：Microsoft Windows 9x/NT/2000；Microsoft Access 2000；Microsoft Word 2000。 样例数据库：“C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb”，Office 2000中包含的例子。可将其中的“产品”表复制到一个新的数据库中，如“D:\db1.mdb”。 窗 体：在数据库“D:\db1.mdb”中新建窗体“窗体1”,其中只包含1个命令按钮“命令0”。 引用ADO：按Alt+F11进入Visual Basic编辑器，执行“工具”->“引用”命令，在弹出的引用窗体中选择“Microsoft ActiveX Data Objects 2.1”或更高版本。 引用Word：再次执行命令“工具”->“引用”，在弹出的引用窗体中选择“Microsoft Word 9.0 Object Library”。 2. 代码详解 在“窗体1”的设计模式下右键单击“命令0”按钮，选择“事件生成器”，进入Visual Basic编辑器，创建过程“Private Sub 命令0_Click()”，其代码如下：
三、在Word中应用ADO直接提取Access数据库中的数据 1. 系统配置 系统软件: Microsoft Windows 9x/NT/2000；Microsoft Word 2000。 样例数据库：“C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb”，Office 2000中包含的例子。 引用ADO：按Alt+F11进入Visual Basic编辑器，执行命令“工具”->“引用”，在弹出的引用窗体中选择“Microsoft ActiveX Data Objects 2.1”或更高版本。 2. 代码详解 进入Visual Basic编辑器，创建过程“Sub Word_ADO()”，其代码如下：
Sub 命令0_Click() '输入表格标题 Title = InputBox(vbCrLf & vbCrLf & "请输入表格标题：", "表格标题", "XX公司产品报价单") If Title = "" Then Title = "XX公司产品报价单" '步骤1：建立数据连接cnn '由于数据库已经打开，所以直接应用CurrentProject.Connection就可以建立连接 Set cnn = New ADODB.Connection Set cnn = CurrentProject.Connection '步骤2：用SQL语句创建记录集rs Set rs = New ADODB.Recordset '设定游标类型与锁定类型 rs.CursorType = adOpenKeyset rs.LockType = adLockOptimistic '制定特定的查询条件，可以是任何有效的SQL查询，甚至包括多表、多条件等复杂的查询，查询条件也常常从窗体取得 SQL = "select 产品名称,单位数量,单价,库存量 from 产品 where 单价>10.00" '创建记录集rs rs.Open SQL, cnn '统计字段数及记录数 total_fields = rs.Fields.Count total_records = rs.RecordCount '步骤3：建立Word文档对象 Set mywdapp = CreateObject("word.application") '调整Word窗口大小 mywdapp.WindowState = wdWindowStateNormal '生成新的Word文档实例 mywdapp.Documents.Add '设置视图为页面视图 mywdapp.ActiveWindow.View.Type = wdPrintView '转到Word视图，显示文档生成过程 mywdapp.Visible = True mywdapp.Activate '设置文档(表格)字体 mywdapp.ActiveDocument.Range.Font.Size = "9" '步骤4：将记录集rs中的字段名称和字段内容输出到Word，各字段之间用制表符分隔 '输出字段名称 For I = 0 To total_fields - 2 mywdapp.Selection.TypeText Text:=rs.Fields(I).Name & vbTab Next I '最后一个字段名称后加回车符 mywdapp.Selection.TypeText Text:=rs.Fields(total_fields - 1).Name & vbCrLf '逐条输出字段内容 Do While Not rs.EOF For I = 0 To total_fields - 2 tmpstr = rs.Fields(I).value If rs.Fields(I).Name = "单价" Then tmpstr = Format(tmpstr, "####.00") End If mywdapp.Selection.TypeText Text:=tmpstr & vbTab Next I '一条记录的最后一个字段后加回车符 mywdapp.Selection.TypeText Text:=rs.Fields(total_fields - 1).value & vbCrLf rs.MoveNext Loop '步骤5：关闭记录集 rs.Close Set rs = Nothing '步骤6：对Word中的数据进行格式化处理 '选定文本，将其转换为表格 '设置视图为普通视图 mywdapp.ActiveWindow.View.Type = wdNormalView '将光标移动到文档末尾 mywdapp.Selection.EndKey Unit:=wdStory '删除文档末尾多余的回车符 mywdapp.Selection.Delete Unit:=wdCharacter, Count:=1 '选中全部内容 mywdapp.Selection.WholeStory '将所选内容转换为表格 mywdapp.Selection.ConvertToTable Separator:=wdSeparateByTabs, DefaultTableBehavior:=wdWord8TableBehavior '将光标移动到文档开头 mywdapp.Selection.HomeKey Unit:=wdStory '选定表格对象 Set Temp_Table = mywdapp.ActiveDocument.Tables(1) '根据需要对表格进行处理，这是制作表格格式的关键，可反复调试 '本例只简单地设置了表格居中、自动调整表格列宽、表头居中、标题行重复、设置表格边框线、设置表格纵向居中 Temp_Table.Rows.Alignment = wdAlignRowCenter Temp_Table.AutoFitBehavior wdAutoFitContent Temp_Table.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter Temp_Table.Rows(1).Range.Rows.HeadingFormat = wdToggle Temp_Table.Borders(wdBorderLeft).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderRight).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderTop).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt Temp_Table.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter '将光标移动到文档开头 mywdapp.Selection.HomeKey Unit:=wdStory '拆分表格 mywdapp.Selection.SplitTable mywdapp.Selection.Font.Name = "黑体" '插入标题 mywdapp.Selection.TypeText Text:=Title & vbCrLf mywdapp.Application.ScreenRefresh '刷屏 '转到Acdess视图，显示结束对话框 mywdapp.Visible = False Msg = "数据提取完毕。" & vbCrLf & vbCrLf Msg = Msg & "总记录数=" & total_records & " 条" MsgBox Msg, vbOKOnly, "数据提取完毕" '转到Word视图，显示文档 mywdapp.Visible = True mywdapp.Activate End Sub
四、两种方法的比较 1. 适用性 上述两种方法都可以满足我们制作特殊报表的要求，但笔者认为Access+ADO+Word更适合于进行多表的复杂查询，编制的东西也更有“程序味”，若既要求录入数据又要求输出特殊报表，可采用该方法；而Word+ADO非常适合于处理表格形式固定的报表，不负责数据录入，只要求输出报表的情况。 2. 复杂性 在程序的编写上，这两种方法也有一些小的差别：前者比后者略微复杂些，在对一些特殊命令的处理上两者也有一些不同。 3. 对报表格式的控制 由于Word本身就是个字处理软件，所以它对文档的控制也就比Access对文档的控制更容易、更灵活，若对表格要求很高，采用后者会更加有效。 4. 处理速度 两者的处理速度基本相当。上述两段程序采用的都是先输出数据，再将其转换为表格的方法，这样处理主要是基于速度上的考虑，特别是对于几百条乃至上千条的记录，其处理速度是比较快的。另外，也可以直接向文档中输出表格，再逐行增加表格或逐单元格地填写数据，但对于大的报表来讲，其速度将大打折扣。影响处理速度的因素是多方面的，主要瓶颈是在Word中，如表格的复杂程度、页面视图、对象的使用，等等。
Sub Word_ADO() '输入表格标题 Title = InputBox(vbCrLf & vbCrLf & "请输入表格标题：", "表格标题", "XX公司产品报价单") If Title = "" Then Title = "XX公司产品报价单" '步骤1：建立数据连接cnn '打开连接,示例数据库：C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb Set cnn = New ADODB.Connection cnn.Provider = "Microsoft.jet.oledb.4.0" cnn.Open "C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb" '步骤2：用SQL语句创建记录集rs Set rs = New ADODB.Recordset rs.CursorType = adOpenKeyset rs.LockType = adLockOptimistic SQL = "select 产品名称,单位数量,单价,库存量 from 产品 where 单价>10.00" rs.Open SQL, cnn total_fields = rs.Fields.Count total_records = rs.RecordCount ActiveDocument.Range.Font.Size = "9" '步骤3：将记录集rs中的字段名称和字段内容输出到Word文档，各字段之间用制表符分隔 For I = 0 To total_fields - 2 Selection.TypeText Text:=rs.Fields(I).Name & vbTab Next I Selection.TypeText Text:=rs.Fields(total_fields - 1).Name & vbCrLf Do While Not rs.EOF For I = 0 To total_fields - 2 tmpstr = rs.Fields(I).value If rs.Fields(I).Name = "单价" Then tmpstr = Format(tmpstr, "####.00") End If Selection.TypeText Text:=tmpstr & vbTab Next I Selection.TypeText Text:=rs.Fields(total_fields - 1).value & vbCrLf rs.MoveNext Loop '步骤4：关闭记录集和连接 rs.Close cnn.Close Set rs = Nothing Set cnn = Nothing '步骤5：对Word中的数据进行格式化处理 ActiveWindow.View.Type = wdNormalView Selection.EndKey Unit:=wdStory Selection.Delete Unit:=wdCharacter, Count:=1 Selection.WholeStory Selection.ConvertToTable Separator:=wdSeparateByTabs, DefaultTableBehavior:=wdWord8TableBehavior Selection.HomeKey Unit:=wdStory Set Temp_Table = ActiveDocument.Tables(1) Temp_Table.Rows.Alignment = wdAlignRowCenter Temp_Table.AutoFitBehavior wdAutoFitContent Temp_Table.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter Temp_Table.Rows(1).Range.Rows.HeadingFormat = wdToggle Temp_Table.Borders(wdBorderLeft).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderRight).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderTop).LineWidth = wdLineWidth150pt Temp_Table.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt Temp_Table.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter Selection.HomeKey Unit:=wdStory Selection.SplitTable Selection.Font.Name = "黑体" Selection.TypeText Text:=Title & vbCrLf Application.ScreenRefresh Msg = "数据提取完毕。" & vbCrLf & vbCrLf Msg = Msg & "总记录数=" & total_records & " 条" MsgBox Msg, vbOKOnly, "数据提取完毕" End Sub