把EXCEL数据写入WORD文档A

把EXCEL工作表数据用VBA写入WORD文档编辑：madmlwt1逐个单元格数据写入WORD表格【问题要求】新建“工程订单.doc”，保存到当前操作的EXCEL文件位置。新建“工程订单.doc”文档中，第一段落写入“工程订单”，第二段落写入“单位：新建装饰有限公司”，第三段落插入一个与当前工作表中数据行列数完全相同的表格。把当前工作表中数据(包括标题行)按单元格读取方式逐个写入WORD表格中。格式设置第一段落黑体、18号、水平居中；第二段落宋体、14号、水平居中；表格在页面中水平居中；表格数据宋体、10号、左对齐；标题行加粗、水平居中。【代码】Sub EXCEL保存为WORD表格数据()Application.ScreenUpdating = False 关闭屏幕刷新开始时间 = Timer 程序运行开始时间(秒)hs = ActiveSheet.UsedRange.Rows.Count 当前工作表数据行数ls = ActiveSheet.UsedRange.Columns.Count 当前工作表数据列数wjM = 工程订单myFile = ActiveWorkbook.Path & & wjM & .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 在指定的所选内容或区域前插入一个新段落 .InsertBefore 工程订单 写入新段落内容 .Font.Name = 黑体 字体 .Font.Size = 18 字号 .ParagraphFormat.Alignment = 1 水平居中 End With With .ActiveDocument.Paragraphs(2).Range .InsertAfter 单位：新建装饰有限公司 .Font.Name = 华文新魏 .Font.Size = 14 .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) 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 = False 如果表格行不是第一行则字形不加粗 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 所有行数据左对齐 .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 - 开始时间 & 秒, , Exc_To_WordApplication.ScreenUpdating = False 关闭屏幕刷新End Sub说明：逐个单元格数据写入WORD表格，就是工作表中的数据单元格，对应已经创建的WORD表格单元格，逐个写入数据，这是EXCEL数据保存为WORD表格最基本、常规的操作方法。把EXCEL数据保存为WORD表格数据，基本思路就是先写入数据再设置格式。上面代码在逐个单元格写入数据过程中，对单元格进行了字体格式设置，如果是庞大数据的写入，可能会降低写入速度。所以最好是把数据完全写入后对表格整体进行所有格式设置。2当前工作表数据复制到WORD文档【问题要求】把被操作的EXCEL当前工作表数据复制粘贴到新建的WORD文档。新建WORD文档“清单.doc”，与被操作的EXCEL文件保存在相同位置。新建WORD文档格式： 第一段落为表格总标题名“复制EXCEL数据粘贴到新建WORD文档”、第二段落为作者或者单位名称“作者：老顽童”、第三段落粘贴复制的EXCEL数据表格。 第一段落黑体、18号、加粗、居中。 第二段落华文新魏、14号、居中。 表格数据标题行宋体、12号、加粗。 表格在页面中水平居中、表格跨页则标题行重复、表格根据内容自动调整列宽。【代码】Sub excel数据复制粘贴到word()Application.ScreenUpdating = False 关闭屏幕刷新qsT = Timer 开始时间ActiveSheet.UsedRange.Copy 复制已经使用的数据区域wjM = 清单 文件名称myFile = ThisWorkbook.Path & & wjM & .doc 保存的文件及路径On Error Resume Next 出现错误跳到下一行Kill myFile 删除文件On Error GoTo 0 不进行错误处理Set wd = CreateObject(word.application) 创建WORD对象wd.Documents.Add.SaveAs Filename:=myFile 新建一个WORD文件并保存With wd.ActiveDocument.Paragraphs(1).Range 当前活动文档中第一段 .InsertParagraphBefore 左边（或前）插入一个新段落 .InsertBefore 复制EXCEL数据粘贴到新建WORD文档 写入新段落内容End 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.ActiveDocument.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 = 华文新魏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.ActiveDocument.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数据复制粘贴到wordApplication.ScreenUpdating = False 关闭屏幕刷新End