VBA Word - 在文档中查找特定文本并替换该特定文本后面的段落内容 [英] VBA Word - Finding specific text in a document and replacing the content of the paragraph following that specific text

问题描述

这是我的 Word 文档中的文本示例:https://www.noelshack.com/2018-31-2-1533054408-word.png

Here is a sample of text from my word document : https://www.noelshack.com/2018-31-2-1533054408-word.png

我是 VBA 新手，我正在尝试编写一个宏来查找特定文本 """"Eligible Currency"" 表示基础货币和此处指定的其他货币:"并替换以下两行(填充带有一些点，不一定在同一段落中)和文本列表(例如:欧元、美元).

I am new to VBA and I am trying to write a macro that looks for the specific text """"Eligible Currency"" means the Base Currency and each other currency specified here:" and replace the two following lines (filled with some dots, not necessarily in the same paragraph) with a list of text (for instance : Euro, Dollar).

到目前为止，我已经能够遍历文档，找到特定文本并使用代码进行

So far I have been able to loop through the document, find the specific text and edit it, using the code :

Sub FindAndFormat()
    Dim objWord As Object
    Dim wdDoc As Object
    Dim ParagraphRange As Object
    Dim intParaCount
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set objWord = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdDoc = objWord.Documents.Open("D:\Modele.docx")
    objWord.Visible = True
    Dim Paragraph As Word.Paragraph
    For Each Paragraph In wdDoc.Paragraphs
        Set ParagraphRange = Paragraph.Range
        ParagraphRange.Find.Text = """Eligible Currency"" means the Base Currency and each other currency specified here:"
        ParagraphRange.Find.Execute
        If ParagraphRange.Find.Found Then
            ParagraphRange.Text = """Eligible Currency"" means the Base Currency and each other currency specified here: Euro, Dollar"
        End If
    Next
End Sub

请注意，整行的样式变得粗体和斜体.

Note that the style of the whole line is getting bold and italic.

https://www.noelshack.com/2018-31-2-1533055581-word2.png

我真正想要实现的是替换虚线:

What I really would like to achieve is replacing the dotty lines :

https://www.noelshack.com/2018-31-2-1533055647-word3.png

现在我的文档中可能还有其他几条虚线，它们可能并不总是包含完全相同数量的点.

Now there may be several other dotty lines in my document, and they may not always contain exactly the same amount of dots.

感谢您的阅读.

推荐答案

尝试以下方法:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = """Eligible Currency""[!:]@:[ ….^13^l^t]{2,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .End = .End - 1
    .Start = .Start + InStr(.Text, ":")
    .Text = Chr(11) & vbTab
    .Collapse wdCollapseEnd
    .Text = "Euro, Dollar"
    .Font.Bold = True
    .Font.Italic = True
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

这篇关于VBA Word - 在文档中查找特定文本并替换该特定文本后面的段落内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！