VBA 把Excel的内容复制到Word的代码？

Posted 2023-03-15

我现在有个表，里面有很多的工作簿，我要做的就是一个方案表，里面都是各种函数加“&”这个做出来的内容，我想做一个导出方案到Word的功能，麻烦高手提供代码，谢谢！
工程范围信息：sheets("方案表").range("a2:h26")。

正好前几天在研究从EXCEL数据导出到WORD中。源代玛整理如下，有一些路径，文件名等需要变更信息的相信你能看明白（已用粗体标识）。提供的只是一个初学者的思路，该代码还有很大可优化空间，因为生成WORD文件的时候估计每个要用3-5秒时间，批量生成时就很烦（批量生成就是用循环，文件名称可以使用时间戳 & 随机数 & 自定义名称,一定不能只用时间戳，因为一秒钟有的时候会抽疯循环两次以上，名称完全一致会报错滴）。

Dim MyExcel As Workbook '定义WORKBOOK变量

Set MyExcel = Workbooks("D:\\你需要导出表的绝对路径")

Dim MyWord As Object '定义变量

Dim MyArray '定义数组变量

Dim MyString as String

MyArray = MyExcel.Sheets("工作表名称").Range("A2:E2").Value '需要从EXCEL中导出的内容放到数组中，因为操作数组比直接调用RANGE要快得多。

Set MyWord = CreateObject("Word.Application") '生成WORD对象

MyString = MyArray1(1, 1) '通过操作数组给变量赋值，可以通过循环给多个变量赋值。

MyFileName = "生成WORD名称名" '文件名称

MyWord.documents.Add '新建文件

MyWord.documents(1).Range.InsertAfter MyString '往WORD内写入数据

fn = "D:\\" & MyFileName '生成文件名

MyWord.documents(1).SaveAs fn '另存文件

MyWord.Close False '不保存关闭文件

MyWord.Quit False

Set MyWord = Nothing '清空变量

Erase MyArray1 '注销数据

参考技术A 完整代码如下：

Public Sub 复制数据()

Dim myFile As String

Dim myRange As Range

Dim docApp As Word.Application

Dim docRange As Word.Range

Set myRange = Worksheets("Sheet1").UsedRange '指定要复制的区域

myRange.Copy

myFile = ThisWorkbook.Path & "\目标Word文档.docx" '指定Word文档

Set docApp = New Word.Application

docApp.Documents.Open myFile, Visible:=True

Set docRange =
docApp.ActiveDocument.Paragraphs(1).Range '指定复制位置

docRange.PasteExcelTable LinkedToExcel:=True, WordFormatting:=False, RTF:=True

docApp.Documents.Close

docApp.Quit

Set myRange = Nothing

Set docRange = Nothing

Set docApp = Nothing

End Sub 参考技术B 正好前几天在研究从EXCEL数据导出到WORD中。源代玛整理如下，有一些路径，文件名等需要变更信息的相信你能看明白（已用粗体标识）。提供的只是一个初学者的思路，该代码还有很大可优化空间，因为生成WORD文件的时候估计每个要用3-5秒时间，批量生成时就很烦（批量生成就是用循环，文件名称可以使用时间戳 & 随机数 & 自定义名称,一定不能只用时间戳，因为一秒钟有的时候会抽疯循环两次以上，名称完全一致会报错滴）。Dim MyExcel As Workbook '定义WORKBOOK变量Set MyExcel = Workbooks("D:\你需要导出表的绝对路径")Dim MyWord As Object '定义变量Dim MyArray '定义数组变量Dim MyString as StringMyArray = ***.sheets("工作表名称").Range("A2:E2").Value '需要从EXCEL中导出的内容放到数组中，因为操作数组比直接调用RANGE要快得多。Set MyWord = CreateObject("***.application") '生成WORD对象MyString = MyArray1(1, 1) '通过操作数组给变量赋值，可以通过循环给多个变量赋值。MyFileName = "生成WORD名称名" '文件名称***.documents.Add '新建文件***.documents(1).***.insertafter MyString '往WORD内写入数据fn = "D:\" & MyFileName '生成文件名***.documents(1).SaveAs fn '另存文件***.close False '不保存关闭文件***.quit FalseSet MyWord = Nothing '清空变量Erase MyArray1 '注销数据 参考技术C 正好前几天在研究从EXCEL数据导出到WORD中。源代玛整理如下，有一些路径，文件名等需要变更信息的相信你能看明白（已用粗体标识）。提供的只是一个初学者的思路，该代码还有很大可优化空间，因为生成WORD文件的时候估计每个要用3-5秒时间，批量生成时就很烦（批量生成就是用循环，文件名称可以使用时间戳 & 随机数 & 自定义名称,一定不能只用时间戳，因为一秒钟有的时候会抽疯循环两次以上，名称完全一致会报错滴）。Dim MyExcel As Workbook '定义WORKBOOK变量Set MyExcel = Workbooks("D:\你需要导出表的绝对路径")Dim MyWord As Object '定义变量Dim MyArray '定义数组变量Dim MyString as StringMyArray = ***.sheets("工作表名称").Range("A2:E2").Value '需要从EXCEL中导出的内容放到数组中，因为操作数组比直接调用RANGE要快得多。Set MyWord = CreateObject("***.application") '生成WORD对象MyString = MyArray1(1, 1) '通过操作数组给变量赋值，可以通过循环给多个变量赋值。MyFileName = "生成WORD名称名" '文件名称***.documents.Add '新建文件***.documents(1).***.insertafter MyString '往WORD内写入数据fn = "D:\" & MyFileName '生成文件名***.documents(1).SaveAs fn '另存文件***.close False '不保存关闭文件***.quit FalseSet MyWord = Nothing '清空变量Erase MyArray1 '注销数据 参考技术D 正好前几天在研究从EXCEL数据导出到WORD中。源代玛整理如下，有一些路径，文件名等需要变更信息的相信你能看明白（已用粗体标识）。提供的只是一个初学者的思路，该代码还有很大可优化空间，因为生成WORD文件的时候估计每个要用3-5秒时间，批量生成时就很烦（批量生成就是用循环，文件名称可以使用时间戳 & 随机数 & 自定义名称,一定不能只用时间戳，因为一秒钟有的时候会抽疯循环两次以上，名称完全一致会报错滴）。Dim MyExcel As Workbook '定义WORKBOOK变量Set MyExcel = Workbooks("D:\你需要导出表的绝对路径")Dim MyWord As Object '定义变量Dim MyArray '定义数组变量Dim MyString as StringMyArray = ***.sheets("工作表名称").Range("A2:E2").Value '需要从EXCEL中导出的内容放到数组中，因为操作数组比直接调用RANGE要快得多。Set MyWord = CreateObject("***.application") '生成WORD对象MyString = MyArray1(1, 1) '通过操作数组给变量赋值，可以通过循环给多个变量赋值。MyFileName = "生成WORD名称名" '文件名称***.documents.Add '新建文件***.documents(1).***.insertafter MyString '往WORD内写入数据fn = "D:\" & MyFileName '生成文件名***.documents(1).SaveAs fn '另存文件***.close False '不保存关闭文件***.quit FalseSet MyWord = Nothing '清空变量Erase MyArray1 '注销数据