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 

 

本文出自 “orangleliu笔记本” 博客，请务必保留此出处http://blog.csdn.net/orangleliu/article/details/38309357