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中找到标记，替换掉，也就是个粘贴操作

    后来想想真的挺简单的，只要能完成几个小方法就能做出来，于是我就按照这个几个小功能开始百度google了。参照着别人的程序把这几个小功能个完成后，在一点一点的集成，每次都进行测试和记录，最后一个相对可用的雏形就出现了。

     

'这个版本开始对模板中所有标签批量替换
'用数组，记录所有标记，然后再用循环的方式替换
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