Question

我想使用Word VBA脚本更改Word文档。 Word文档由书目记录组成。我想复制每个记录的第一次出现的字段\ TRF并更改其字段标签（进入\ OTT）。我录制了一个VBA脚本，如果我将光标放在第一次出现的\ TRF前面，它可以正常工作。我希望VBA脚本重复整个文档中的更改，但只更改\ TRF的所有第一次出现。使用键盘键（Ctrl + F）和文本录制VBA脚本不起作用。我试图将vba代码添加到VBA脚本中但哪些不成功..我必须添加到我的VBA脚本的正确语法是什么？

原文：
（此示例显示一条记录，文档包含更多记录）

\ PPN 375496173
\ TTT Pour un autre respect sur l＆＃39; art beti / Bienvenu Cyrille Bela
\ TRF喀麦隆
\ TRF Beti
\ TRF雕塑
\ TRF视觉艺术
\ DAT 15-08-14
\ DAV 20140815
\ SIG AFRIKA 47231
\ ISP文字
\ END

更改后的文字

\ PPN 375496173
\ TTT Pour un autre respect sur l＆＃39; art beti / Bienvenu Cyrille Bela
\ TRF喀麦隆
\ OTT喀麦隆
\ TRF Beti
\ TRF雕塑
\ TRF视觉艺术
\ DAT 15-08-14
\ DAV 20140815
\ SIG AFRIKA 47231
\ ISP文字
\ END

宏不正确：

Sub MacroCountry()  

' MacroCountry Macro  

With ActiveDocument.Content.Find  

'Search for \PPN (beginning of the record) and then search for \TRF  

      .Text = "\PPN"  
      .Text = "\TRF"  

'the selection part of the Macro works fine, it selects the line, duplicates it and changes the field label  

    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
    Selection.TypeText Text:="\Ott "

   End With 

  Loop  

End Sub

Answer 1

我试图找到更多关于MS Word框架的信息，所以我用它作为练习。你可以试试这个。前提条件是所有行都以换行符结束，因此每行都是一个段落。

Sub InsertLines()
    Dim rng As Range
    Dim i As Integer
    Dim doc As Document
    Dim line As String

    Dim inBlock As Boolean, found As Boolean

    Set doc = ThisDocument

    i = 1

    While i < ThisDocument.Paragraphs.Count
        line = doc.Paragraphs(i).Range.Text
        If InStr(line, "\PPN") > 0 Then
            inBlock = True
            found = False
        End If
        If InStr(line, "\END") > 0 Then
            inBlock = False
        End If
        If inBlock And Not found Then
            If InStr(line, "\TRF") > 0 Then
                doc.Paragraphs(i).Range.InsertAfter "\OTT " & Mid(line, 5)
                found = True
            End If
        End If
        i = i + 1
    Wend
End Sub

我确信有更优雅的解决方案，但我希望这是一个解决方案。我尝试了一下RegExp和Find对象，但这更简单。

使用VBA脚本复制和更改Word文档中的文本

1 个答案: