在 Word VBA 中为文本到语音静音代码添加缺失的括号

Question

我目前正在尝试制作一个宏来查找损坏的静音代码并添加缺少的括号。 第一次可以用，但后来就不行了

基本上这应该可以解决以下问题：

约翰 [slnc 50]] 美国能源部 [[slnc 50]

到

约翰 [[slnc 50]] 美国能源部 [[slnc 50]]

tempArray 中将包含更多项目，更长或更短的暂停，但我以三个为例

Dim var As String
Dim tempArray() As Variant
Dim i As Integer

                           ' Example
tempArray = Array("[[slnc 0]]", "[[slnc 25]]", "[[slnc 50]]")

For i = LBound(tempArray) To UBound(tempArray)
    var = tempArray(i)
   
 ' Check if the opening bracket is missing
    If Left(var, 2) <> "[[" Then
        var = "[[" & var
    End If
    
    ' Check if the closing bracket is missing
    If Right(var, 2) <> "]]" Then
        var = var & "]]"
    End If

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    With Selection.Find
        .Text = var
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Selection.Find.Execute Replace:=wdReplaceAll
Next

TL;DR：需要这个来添加缺失的括号，工作了一次，再也没有工作过。想知道我缺少什么或我可以添加什么

Answer 1

• tempArray will have more items in it, both longer and shorter pause

  您不必一直维护该列表。

• 假设文档中连续的方括号（例如

  [[[

  ）不超过两个，否则需要额外的代码来处理。

• 该代码替换了Word文档中的所有实例。

Option Explicit
Sub ReplaceBracket()
    Dim aTxt, sRepTxt As String, i As Long
    aTxt = Array("\[\[([!\[\]]@)\]\]", "\[([!\[\]]@)\]\]", "\[\[([!\[\]]@)\]", "||([!\[\]]@)||")
    For i = 0 To UBound(aTxt)
        sRepTxt = IIf(i = UBound(aTxt), "[[\1]]", "||\1||")
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            .Text = aTxt(i)
            .Replacement.Text = sRepTxt
            .Execute Replace:=wdReplaceAll
        End With
    Next
End Sub