excel批量生成指定名称的独立word文件。

wuxiang_123 · 发表于 2013-12-4 12:39

本帖最后由 wuxiang_123 于 2013-12-4 13:35 编辑

求助各位大神，我有一个excel工作簿和一个word文档模板，现在需要根据excel工作簿中，A列的内容，批量生成独立的word文档，且生成的这些文档的内容和word文档模板的内容一样。

附件提问内容截图：
附件内容截图.jpg

excel批量转word.rar (32.36 KB, 下载次数: 564)

该贴已经同步到 wuxiang_123的微博

wuxiang_123 · 发表于 2013-12-4 13:23

已经解决。冻大师版主的代码：
Sub Macro1()

Sub PatchWord()
Dim i As Integer
For i = 2 To Range("a65536").End(xlUp).Row
FileCopy ThisWorkbook.Path & "\word模板.docx", ThisWorkbook.Path & "" & Cells(i, 1) & ".docx"
Next
End Sub

复制代码

赵刚版主的代码：

Sub Macro1()
Dim p$, f$, f2, i&, arr
arr = [a1].CurrentRegion
p = ThisWorkbook.Path & ""
f = p & "word模板.docx"
For i = 2 To UBound(arr)
FileCopy f, p & arr(i, 1) & ".docx"
Next
MsgBox "ok"
End Sub

复制代码

佛山小老鼠版主代码：

Sub 生成word()
Dim MyWord, NewDoc, WordName
Application.DisplayAlerts = False
Set MyWord = CreateObject("Word.Application")
MyPath = ThisWorkbook.Path & ""
For x = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
WordName = Sheets(1).Cells(x, 1)
Set NewDoc = MyWord.Documents.Add
With NewDoc
.Activate
.SaveAs Filename:=MyPath & WordName & ".docx"
.Close
End With
Next x
MyWord.Quit
Set MyWord = Nothing
Application.DisplayAlerts = True
End Sub

复制代码

注意：佛山小老鼠版主的代码只是批量生成空白word文件，没有复制word文档模板的内容的。

感谢三位版主的支持。

wanhu369714 · 发表于 2016-11-22 14:25

犀利啊学习了

ggluzhekun · 发表于 2017-4-27 09:31

先顶一下，再看看。

nancy_2018 · 发表于 2018-7-16 10:04

樓主實在太厲害了!!
完全符合目前的需求
感謝~!!

tfeng_no1 · 发表于 2018-7-26 10:26

学习.....................................................

eh蝴蝶效应 · 发表于 2022-9-9 07:32

wuxiang_123 发表于 2013-12-4 13:23
已经解决。冻大师版主的代码：
Sub Macro1()
赵刚版主的代码：

运行后会报错

eh蝴蝶效应 · 发表于 2022-9-9 07:47

wuxiang_123 发表于 2013-12-4 13:23
已经解决。冻大师版主的代码：
Sub Macro1()
赵刚版主的代码：

大咖好，运行宏的时候，能不能弹出一个保存位置的选择窗口，批量将这些word保存到任何指定位置中呢？

sunshuangzhong · 发表于 2022-9-9 07:47

符合实际需要，记个号

h2016 · 发表于 2024-9-4 20:27

liuxiabaioji xuexi

		自动登录	找回密码
密码			免费注册

[已解决] excel批量生成指定名称的独立word文件。

评分