把EXCEL数据写入WORD文档A

1、VBA在EXCEL中操作WORD表格之七 第 7 页 共 7 页把EXCEL工作表数据用VBA写入WORD文档编辑：madmlwt1逐个单元格数据写入WORD表格【问题要求】新建“工程订单.doc”，保存到当前操作的EXCEL文件位置。新建“工程订单.doc”文档中，第一段落写入“工程订单”，第二段落写入“单位：新建装饰有限公司”，第三段落插入一个与当前工作表中数据行列数完全相同的表格。把当前工作表中数据(包括标题行)按单元格读取方式逐个写入WORD表格中。格式设置第一段落黑体、18号、水平居中；第二段落宋体、14号、水平居中；表格在页面中水平居中；表格数据宋体、10号、左对齐；标题行加粗、水

2、平居中。【代码】Sub EXCEL保存为WORD表格数据()Application.ScreenUpdating = False '关闭屏幕刷新开始时间 = Timer '程序运行开始时间(秒)hs = ActiveSheet.UsedRange.Rows.Count '当前工作表数据行数ls = ActiveSheet.UsedRange.Columns.Count '当前工作表数据列数wjM = "工程订单"myFile = ActiveWorkbook.Path & "" & wjM & &q

3、uot;.doc" '保存的文件及路径On Error Resume Next '出现错误跳到下一行Kill myFile '删除文件On Error GoTo 0 '不进行错误处理Set wd = CreateObject("Word.Application") '定义一个Word对象变量With wd .Documents.Add '创建一个新的Word文档 With .ActiveDocument.Paragraphs(1).Range '当前活动文档中 .InsertParagraphBefore &

4、#39;在指定的所选内容或区域前插入一个新段落 .InsertBefore "工程订单" '写入新段落内容 .Font.Name = "黑体" '字体 .Font.Size = 18 '字号 .ParagraphFormat.Alignment = 1 '水平居中 End With With .ActiveDocument.Paragraphs(2).Range .InsertAfter "单位：新建装饰有限公司" .Font.Name = "华文新魏" .Font.Size = 1

5、4 .ParagraphFormat.Alignment = 1 End With .ActiveDocument.Paragraphs(2).Range.InsertParagraphAfter '在第二段后面插入一个新的段落 .ActiveDocument.Paragraphs(3).Range.Select '选中第三段落 .ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=hs, NumColumns:=ls '插入hs行ls列表格 With .ActiveDocument.Tables(1)

6、 'WORD表格 For h = 1 To hs '从第一行循环到hs行 For l = 1 To ls '从第1列循环到ls列 .Cell(h, l).Range = ActiveSheet.Cells(h, l) '把当前工作表单元格数据写入WORD表格 With .Cell(h, l).Range '单元格字体设置 .Font.Name = "宋体" '字体 .Font.Size = 10 '字号 .Font.Bold = True '加粗 If h > 1 Then .Font.Bold = Fa

7、lse '如果表格行不是第一行则字形不加粗 End With Next l Next h End With .Selection.Tables(1).AutoFitBehavior (1) '根据内容自动调整表格 .Selection.Tables(1).Rows(1).HeadingFormat = 9999998 '标题行重复 .ActiveDocument.Tables(1).Rows.Alignment = 1 '表格水平居中 .Selection.Tables(1).Range.ParagraphFormat.Alignment = 3 '所有

8、行数据左对齐 .Selection.Tables(1).Rows(1).Range.ParagraphFormat.Alignment = 1 '标题行居中 .ActiveDocument.SaveAs myFile '保存新建Word文档 .Quit '关闭新建文档窗口End WithSet wd = NothingMsgBox Chr(10) & "成功创建一个WORD表格" & wjM _ & Chr(10) & Chr(10) & "共用时 " & Timer - 开始时间

9、& " 秒", , "Exc_To_Word"Application.ScreenUpdating = False '关闭屏幕刷新End Sub说明：逐个单元格数据写入WORD表格，就是工作表中的数据单元格，对应已经创建的WORD表格单元格，逐个写入数据，这是EXCEL数据保存为WORD表格最基本、常规的操作方法。把EXCEL数据保存为WORD表格数据，基本思路就是先写入数据再设置格式。上面代码在逐个单元格写入数据过程中，对单元格进行了字体格式设置，如果是庞大数据的写入，可能会降低写入速度。所以最好是把数据完全写入后对表格整体进行所有格式

10、设置。2当前工作表数据复制到WORD文档【问题要求】把被操作的EXCEL当前工作表数据复制粘贴到新建的WORD文档。新建WORD文档“清单.doc”，与被操作的EXCEL文件保存在相同位置。新建WORD文档格式： 第一段落为表格总标题名“复制EXCEL数据粘贴到新建WORD文档”、第二段落为作者或者单位名称“作者：老顽童”、第三段落粘贴复制的EXCEL数据表格。 第一段落黑体、18号、加粗、居中。 第二段落华文新魏、14号、居中。 表格数据标题行宋体、12号、加粗。 表格在页面中水平居中、表格跨页则标题行重复、表格根据内容自动调整列宽。【代码】Sub excel数据复制粘贴到word()App

11、lication.ScreenUpdating = False '关闭屏幕刷新qsT = Timer '开始时间ActiveSheet.UsedRange.Copy '复制已经使用的数据区域wjM = "清单" '文件名称myFile = ThisWorkbook.Path & "" & wjM & ".doc" '保存的文件及路径On Error Resume Next '出现错误跳到下一行Kill myFile '删除文件On Error GoTo 0

12、 '不进行错误处理Set wd = CreateObject("word.application") '创建WORD对象wd.Documents.Add.SaveAs Filename:=myFile '新建一个WORD文件并保存With wd.ActiveDocument.Paragraphs(1).Range '当前活动文档中第一段 .InsertParagraphBefore '左边（或前）插入一个新段落 .InsertBefore "复制EXCEL数据粘贴到新建WORD文档" '写入新段落内容End

13、 Withwd.ActiveDocument.Paragraphs(1).Range.InsertAfter "作者：老顽童" '第一段右边插入新段落wd.ActiveDocument.Paragraphs(2).Range.InsertParagraphAfter '在第二段后面插入一个新的段落wd.ActiveDocument.Paragraphs(3).Range.Select '选中第三段落wd.Selection.PasteExcelTable False, True, False '粘贴复制的EXCEL表格With wd.Acti

14、veDocument.Paragraphs(1).Range '第一段文本格式设置 .ParagraphFormat.Alignment = 1 '水平居中 .Font.Size = 18 '字号 .Font.Name = "黑体" '字体 .Font.Bold = True '加粗End WithWith wd.ActiveDocument.Paragraphs(2).Range '第二段文本格式设置 .ParagraphFormat.Alignment = 1 .Font.Size = 14 .Font.Name = &q

15、uot;华文新魏"End WithWith wd.Selection.Tables(1) .AutoFitBehavior (1) '根据内容调整表格列宽 .Rows(1).HeadingFormat = 9999998 '标题行重复 .Rows.Alignment = 1 '表格水平居中 With .Rows(1).Range .Font.Size = 12 '字号 .Font.Name = "宋体" '字体 .Font.Bold = True '加粗 End WithEnd Withwd.ActiveDocume

16、nt.Save '保存修改wd.ActiveDocument.Close '关闭文档wd.Quit '关闭WORD程序Set myRange = Nothing '释放内存Set adoc = Nothing '释放内存Set wd = Nothing '释放内存Application.CutCopyMode = False '撤销复制状态MsgBox Chr(10) & "成功地把当前EXCEL数据复制粘贴到WORD文档" _ & Chr(10) & Chr(10) & "共计用去时间 " & Timer - qsT & " 秒", , "excel数据复制粘贴到word"Applicatio