excel 宏编辑，批量复制表单文件

原理 

获取单元格变量，然后复制文件A到B的同时重命名

原理：

A-mode.docx

里面有很多表格内容，如日期，名字，年月日，这些内容的数据都存储在Excel表中，可以使用Mail Merge 功能进行生成，但是Mail Merge 功能局限性比较大，比如说

./ok/ 

B-Xiaoming_ID_00123.docx

B-XiaoKing_ID_00124.docx

B-lizing_ID_00128.docx

B-Huanming_ID_00982.docx

形象一点：一个表单一个word 文档

 

因此可以通过以下代码实现

 

Sub bath_writing_sc()

Dim i As Integer
Dim ID, ENname, CNname, Month, Day, FullPath As String

Set docApp = CreateObject("Word.Application")

For i = 2 To Worksheets(1).UsedRange.Rows.Count
ID = Worksheets(1).Cells(i, 2).Value
ENname = Worksheets(1).Cells(i, 3).Value
CNname = Worksheets(1).Cells(i, 4).Value
Month = Worksheets(1).Cells(i, 5).Value
Day = Worksheets(1).Cells(i, 6).Value
FullPath = Worksheets(1).Cells(i, 8).Value


FileCopy ThisWorkbook.Path & "\Model.docx", ThisWorkbook.Path & "\ok\" & FullPath & ".docx"


Set wd = docApp.documents.Open(ThisWorkbook.Path & "\ok\" & FullPath & ".docx")
    docApp.Visible = False
    'docApp.Activate     '让打开后的文件显示在桌面（成为当前活动文档）
 
        Set myRange = wd.Content
         myRange.Find.Execute findtext:="#Name#", replacewith:=ENname, Replace:=2
         myRange.Find.Execute findtext:="#ID#", replacewith:=ID, Replace:=2
         myRange.Find.Execute findtext:="#Day#", replacewith:=Day, Replace:=2
         myRange.Find.Execute findtext:="#Month#", replacewith:=Month, Replace:=2
wd.Save
     
Next

docApp.Quit
MsgBox "Mission Completed"
End Sub