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

wuxiang_123

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

附件提问内容截图：



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

2013-12-4 12:38 上传

点击文件名下载附件

该贴已经同步到 wuxiang_123的微博

wuxiang_123

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

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

复制代码

赵刚版主的代码：

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

复制代码

佛山小老鼠版主代码：

1. Sub 生成word()
   
2.     Dim MyWord, NewDoc, WordName
   
3.     Application.DisplayAlerts = False
   
4.     Set MyWord = CreateObject("Word.Application")
   
5.     MyPath = ThisWorkbook.Path & ""
   
6.     For x = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   
7.     WordName = Sheets(1).Cells(x, 1)
   
8.     Set NewDoc = MyWord.Documents.Add
   
9.         With NewDoc
   
10.             .Activate
    
11.             .SaveAs Filename:=MyPath & WordName & ".docx"
    
12.             .Close
    
13.         End With
    
14.     Next x
    
15.     MyWord.Quit
    
16.     Set MyWord = Nothing
    
17.     Application.DisplayAlerts = True
    
18. End Sub

复制代码

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

感谢三位版主的支持。

wanhu369714

犀利啊  学习了

ggluzhekun

先顶一下，再看看。

nancy_2018

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

tfeng_no1

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

eh蝴蝶效应

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

运行后会报错

eh蝴蝶效应

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

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

sunshuangzhong

符合实际需要，记个号

h2016

liuxiabaioji xuexi