很急！麻烦各位大佬帮忙做下EXCEL表格的宏，能够选择输出到固定模板的word文件。

dandangenius

各位大佬、牛人：
       附件是一个EXCEL的数据和一个WORD模板，希望能够把EXCEL里的数据自动生成到WORD模板里。希望能够在每个EXCEL SHEET里做个生成按钮，并且可以根据我要求输入选择第几行到第几行，然后输出相对应的WORD文件

比如：输入 6 到12，然后点击按钮生成，就自动生成6行到12行内容的WORD模板，最后在一个WORD文件里。WORD模板大小不能变，希望填充内容字体大小可以自动根据word模板进行调整。非常 感谢哈

opiona

故障报告模板.rar (89.51 KB, 下载次数: 100)

2018-3-26 19:31 上传

点击文件名下载附件

自己调整一下模板，基本适应大多数情况
具体参照黄色部分
需要替换的部分，在Excel标题中要存在

opiona

代码如下：  注意引用：word

1.     PATH1 = ThisWorkbook.Path & "\当前模板.docx"
   
2.     Path3 = ThisWorkbook.Path & "\结果"
   
3.     FIRSTROW = 4  '//标题所在行
   
4.     Set SH0 = Sheets("FFS#1")
   
5.     LASTROW = SH0.Range("B65536").End(3).Row
   
6.     Set FSO = CreateObject("Scripting.FileSystemObject")
   
7.     If FSO.FolderExists(Path3) = False Then
   
8.         MkDir Path3    '//创建文件夹
   
9.     End If
   
10.     For IROW = FIRSTROW + 1 To LASTROW
    
11.         Application.StatusBar = "总数：" & LASTROW - FIRSTROW & " 个   当前是第：" & IROW - FIRSTROW & " 个   当前序号名是：" & SH0.Cells(IROW, 1).Value
    
12.         DoEvents
    
13.         Set WordDoc = WordApp.Documents.Open(PATH1)  '//打开word模板
    
14.         WordApp.Visible = False    '关闭word文档的显示
    
15.         WordApp.Selection.HomeKey unit:=wdStory    '光标置于文件首部
    
16.         Rem 单个替换
    
17.         STR1 = "|设备编号|"
    
18.         STR2 = SH0.Cells(3, 4).Value
    
19.         Rem 多次替换
    
20.         For I = 0 To 3
    
21.             Do While WordApp.Selection.Find.Execute(STR1) = True   '查找到指定字符串
    
22.                 WordApp.Selection.Text = STR2    '替换字符串
    
23.                 WordApp.Selection.HomeKey unit:=wdStory    '光标置于文件
    
24.             Loop
    
25.         Next
    
26.         For ICOL = 1 To SH0.Range("HZ" & FIRSTROW).End(xlToLeft).Column
    
27.             Rem 第一行
    
28.             WordApp.Selection.HomeKey unit:=wdStory    '光标置于文件首部
    
29.             Rem 成行替换
    
30.             STR1 = "|" & Replace(Replace(SH0.Cells(FIRSTROW, ICOL).Value, " ", ""), Chr(10), "") & "|"
    
31.             If InStr(SH0.Cells(FIRSTROW, ICOL).Value, "日期") + InStr(SH0.Cells(FIRSTROW, ICOL).Value, "时间") > 0 Then
    
32.                 Rem 日期格式
    
33.                 STR2 = Format(SH0.Cells(IROW, ICOL).Value, "yyyy年MM月dd日")
    
34.             Else
    
35.                 STR2 = SH0.Cells(IROW, ICOL).Value
    
36.             End If
    
37.             Rem 多次替换
    
38.             For I = 0 To 3
    
39.                 Do While WordApp.Selection.Find.Execute(STR1) = True   '查找到指定字符串
    
40.                     WordApp.Selection.Text = STR2    '替换字符串
    
41.                     WordApp.Selection.HomeKey unit:=wdStory    '光标置于文件
    
42.                 Loop
    
43.             Next
    
44.         Next ICOL
    
45.         WordApp.Visible = True    '弹出word框
    
46.         WordDoc.SaveAs Path3 & "" & SH0.Cells(IROW, 1).Value & ".doc"
    
47.         WordDoc.Close True
    
48.     Next
    
49.     WordApp.Quit
    
50.     Set WordDoc = Nothing

复制代码

dandangenius

opiona 发表于 2018-3-26 19:36
代码如下：  注意引用：word

太牛了，超级感谢哈，谢谢谢谢。

dandangenius

opiona 发表于 2018-3-26 19:31
自己调整一下模板，基本适应大多数情况
具体参照黄色部分
需要替换的部分，在Excel标题中要存在

您好，不好意思呀，我基础太差。可不可以按钮设置成可选择性的生成模板文件呢，比如我选1到6，它就自动生成编号1到编号6的文件呢，还有最好不要生成单个WORD文件，希望能够全部连续在一个WORD文件里哈。
还有如果把故障描述处理的内容放到WORD故障处理中，故障描述和故障细节对应那就更好啦

dandangenius

模板更新，WORD文件里标黄的都需要按EXECL表里内容填充哈，感谢大牛啦

dyzx

opiona 发表于 2018-3-26 19:36
代码如下：  注意引用：word

opiona老师：如果我还要输送到打印机打印，应该怎样增加代码，多谢指教。