VBA--word模板标签替换操作
最近项目中有个需求，就是用word生成word，把一份标签对组成的word源材料，放到word模板中。所以就想到用vba来做，可是之前就没有接触过这些啊，连个word排版用的都不怎么好，于是就到下载频道搜索关键词vba。从搜索的结果来看，几乎全都是用Excel VBA的资料，word少之又少啊，最后找了几篇比较好的经验和word vba的api下载下来了。
可能是之前没有遇到过那么急的开发任务，所以开始的时候就到网上搜索啊，百度啊，google啊，新浪共享，文库，还有我们的下载频道。。。当发现资料少，并且重复率又是那么高的时候真的有些失落。到后来去看别人的资料的时候又头大了，闷着头不停的看，看语法，看例子，就是找不到相似功能的东西。最后不得已去office的论坛发了个帖子，结果还没人回复。这已经过去了2天了。。。。
今天上午来到公司的时候我就想不能再照着原来的路子走了，于是我就拿着需求好好的分析了下，这个程序具体要实现那几个逻辑，分析如下：
材料：1. 模板word1 里面含有如此样的标签
${111}
${112}
2 存放标签对的word2中，把资源都放在标签对中
3 我要做的不就是吧标签对中的东西替换掉标签吗，几个主要的逻辑就出来了
*对标签的定位，怎么找打标签对，就是个查找的方法 *取出标签对的内容，怎么截取这之间的内容放到粘贴板 *再次在word1中找到标记，替换掉，也就是个粘贴操作
'这个版本开始对模板中所有标签批量替换
'用数组，记录所有标记，然后再用循环的方式替换
Sub 实现循环V3()
Dim arr()
Dim str As String
arr = Array("111", "112") '把需要查找的标签的号写到数组里
For i = 0 To 1
str = arr(i)
Documents("src.docx").Activate
Selection.Find.ClearFormatting '这里的word2为因子文件,去这里取标签对
With Selection.Find
strM = "<%" + str + "%>"
.Text = strM
.Wrap = wdFindContinue
End With
Selection.Find.Execute
a = Selection.End 'Selection 对象就是选中的意思，例如选中文档的一部分
Selection.Find.ClearFormatting
With Selection.Find
strJ = "<%" + str + "%/>"
.Text = strJ
.Wrap = wdFindContinue
End With
Selection.Find.Execute
b = Selection.Start
Selection.Start = a + 1
Selection.End = b
Selection.Copy '把取到的内容放到粘贴板中
Documents("test.doc").Activate
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
strH = "${" + str + "}"
.Execute FindText:=strH
End With
Selection.Range.Paste '在模板文件word1中找到标记并粘贴
Next
End Sub
虽然说程序比较粗劣，但是通过这个过程让我觉得程序还是要慢慢的写出来，一点一点的构造，把小模块组装成大功能，而不是一上来就要怎样怎样，急功近利反而更耗时耗力。 这就是今天的一点收获。
附：这是后来写的相对完善的一个脚本，只不过标记是用硬编码的，如果有需要的话引用vb的正则表达匹配特定格式的标记。
Sub 模板提取()
Dim p As String
Dim fname As String
Dim tname As String
tname = ActiveDocument.Name
fname = "保监会文件因子上传示例.doc" '因子文件的名称
p = ActiveDocument.Path
'MsgBox tname
'MsgBox fname
ps = p + "\" + fname '找到同一级目录并且得到要打开文件的路径，资源文件的名称！！！
Set wrd = GetObject(, "Word.Application")
wrd.Visible = True
For Each doc In Documents
If doc.Name = fname Then Found = True '判断是否打开，如果没有打开就打开
Next
If Found <> True Then
wrd.Documents.Open ps
End If
Dim arr() As Variant
Dim str As String
Dim num As Integer
'把需要查找的标签的号写到数组里，!!!需要修改的！！！
arr = Array("8000008", "8000130", "8000147", "8000148", "8000149", "8000150", "8000153", "8000154", "8000157", "8009448", "8009449", "8009451", "8009446", "8011322")
num = UBound(arr) '获取数组长度
'MsgBox num
For i = 0 To num
str = arr(i)
Documents(fname).Activate
Selection.Find.ClearFormatting '这里的word2为因子文件,去这里取标签对
With Selection.Find
strM = "<%" + str + "%>" '标签对的样式，需要修改！！！
.Text = strM
.Wrap = wdFindContinue
End With
Selection.Find.Execute
a = Selection.End 'Selection 对象就是选中的意思，例如选中文档的一部分
Selection.Find.ClearFormatting
With Selection.Find
strJ = "</%" + str + "%>" '标签对的样式，需要修改！！！
.Text = strJ
.Wrap = wdFindContinue
End With
Selection.Find.Execute
b = Selection.Start
Selection.Start = a + 1
Selection.End = b
Selection.Copy '把取到的内容放到粘贴板中
Documents(tname).Activate
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
strH = str '模板标记的样式，需要修改！！！
.Execute FindText:=strH
End With
Selection.Range.Paste '在模板文件中找到标记并粘贴
Next
End Sub
本文出自 “orangleliu笔记本” 博客，请务必保留此出处http://blog.csdn.net/orangleliu/article/details/38309357