VBA или VB.NET MS Word Выделение текста во вложенных скобках

Question

Я пытаюсь понять, как выделить текст в квадратных скобках в текстовом документе, но у него есть вложенные скобки.Я мог бы циклически проходить весь символ документа, открывая и закрывая скобки для отслеживания символов, но это неэффективно в больших документах.Я хотел бы выделить вложенные скобки другим цветом.

[какой-то текст выделен желтым цветом [что-то еще выделено зеленым цветом], еще один текст выделен желтым цветом [еще один элемент выделен зеленым цветом], а остальные выделены желтым цветом]

Я использовал это первоначально (vb.netдо тех пор, пока я не наткнулся на вложенные скобки, то есть когда он ломается:

    'Toggles the highlighting of brackets in the document off and on
    'Get Active document 
    Dim wdDoc As Word.Document
    wdDoc = wdApp.ActiveDocument

    'Set highlight color to yellow
    wdApp.Options.DefaultHighlightColorIndex = Word.WdColorIndex.wdYellow

    'Search for text between brackets and highlight text
    With wdDoc.Content.Find
        .ClearFormatting()
        .Text = "\[*\]"
        With .Replacement
            .Text = ""
            .ClearFormatting()
            .Highlight = TogBtnBrackets.Checked
        End With
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = True
        .MatchWildcards = True
        .Execute(Replace:=Word.WdReplace.wdReplaceAll)
    End With

    'Finished set wdDoc to nothing 
    wdDoc = Nothing

    Dim Tog As String = ""
    If TogBtnBrackets.Checked = True Then
        Tog = "Highlighted"
        TogBtnBrackets.Label = "Bracket Highlighting - On "
    Else
        Tog = "un-Highlighted"
        TogBtnBrackets.Label = "Bracket Highlighting - Off"
    End If

Я нашел несколько вещей, говорящих об использовании RegEx, но я действительно незнаком с ними и не могу обернуться вокруг них,Также кажется, что вам нужно знать количество уровней "гнезда", чтобы написать правильное регулярное выражение в любом случае, и я не всегда буду это знать.

Answer 1

Спасибо Синди Мейстер Ваш код был отличным местом для меня, чтобы начать отклеиваться.Он отлично работал для получения скобок, которые были вложенными, но не выделяли внешнюю информацию в скобках.Наконец-то я нашел решение в коде VBA, которое позже перейду на VB.NET.

Option Base 1

Sub HighlightNestedBrackets()

Dim Ary() As Variant
Dim cntr As Integer
Dim NumberOpenBrackets As Integer
Dim i As Integer
Dim OpenBracket As String
Dim CloseBracket As String

ReDim Ary(2, 1)
cntr = 1

'Change to [], or (), or {}, etc. as needed
OpenBracket = "\["
CloseBracket = "\]"

'Find opening brackets and store in array
Call FindOpenCloseBracket(Ary, cntr, ActiveDocument.Content, OpenBracket, True)
'Check number of open brackers
NumberOpenBrackets = UBound(Ary, 2)

'Find closing brackets and store in array
Call FindOpenCloseBracket(Ary, cntr, ActiveDocument.Content, CloseBracket, False)
'Check balanced number of open close Brackets
If NumberOpenBrackets <> UBound(Ary, 2) / 2 Then
    MsgBox "Unbalanced Open Close Bracket Pairs", vbExclamation, "Error"
    Exit Sub
End If

'Sort the array by bracket position
Call BubbleSort(Ary, 1)

'Set each bracket pair
Dim PairAry() As Variant
ReDim PairAry(1)

Dim FP As Boolean 'First pass variable
FP = True

For i = LBound(Ary, 2) To UBound(Ary, 2)
    If FP = True Then 'on first pass place first bracket number in array
        PairAry(1) = Ary(2, i)
        FP = False
    Else
        If Ary(2, i) <> 0 Then 'if it is not a closing bracket redim the array and place the bracket number in the bottom of the array
            ReDim Preserve PairAry(UBound(PairAry) + 1)
            PairAry(UBound(PairAry)) = Ary(2, i)
        Else 'if it is a closing bracket then the last bracket number is the placed in the pair array is the associated opening bracket
            Ary(2, i) = PairAry(UBound(PairAry))
            If UBound(PairAry) <> 1 Then 'can't redim under lower bound
                'remove the last used opening bracket number
                ReDim Preserve PairAry(UBound(PairAry) - 1)
            End If
        End If
    End If
Next i

'sort array again by the bracket pair column this time to get pairs together
Call BubbleSort(Ary, 2)

'loop through each pair and highlight as needed
For i = LBound(Ary, 2) To UBound(Ary, 2) Step 2 'step by 2 since pairs
    'you coule use an elseif here if you know the number of nested layers I should only have 2 layers in mine so I only needed else
    If Ary(1, i) > Ary(1, i + 1) Then 'bubble sort doesnt always get pairs character position first last correct so you need to check
        'If already highlighted yellow then highlight green
        If ActiveDocument.Range(Ary(1, i + 1), Ary(1, i) + 1).HighlightColorIndex = wdYellow Then
            ActiveDocument.Range(Ary(1, i + 1), Ary(1, i) + 1).HighlightColorIndex = wdBrightGreen
        Else
            ActiveDocument.Range(Ary(1, i + 1), Ary(1, i) + 1).HighlightColorIndex = wdYellow
        End If
    Else
        'If already highlighted yellow then highlight green
        If ActiveDocument.Range(Ary(1, i), Ary(1, i + 1) + 1).HighlightColorIndex = wdYellow Then
            ActiveDocument.Range(Ary(1, i), Ary(1, i + 1) + 1).HighlightColorIndex = wdBrightGreen
        Else
            ActiveDocument.Range(Ary(1, i), Ary(1, i + 1) + 1).HighlightColorIndex = wdYellow
        End If
    End If
Next i

End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub FindOpenCloseBracket(ByRef Ary() As Variant, ByRef cntr As Integer, ByVal oRng As Range, ByVal TextToFind As String, OpenBracket As Boolean)

With oRng.Find
    .ClearFormatting
    .Text = TextToFind '"\["
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    Do While .Execute
        With oRng
            ReDim Preserve Ary(2, cntr)
            Ary(1, cntr) = oRng.Start 'save barcket position in array
            If OpenBracket = True Then
                Ary(2, cntr) = cntr 'save opening bracket number
            Else
                Ary(2, cntr) = 0 'place 0 in array to indicate closing bracket
            End If
            'Debug.Print oRng.Start & " - " & Cntr
            cntr = cntr + 1
        End With
    Loop
End With

End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub BubbleSort(ByRef Ary() As Variant, Col As Long)
'Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim Temp1 As Integer
Dim Temp2 As Integer

First = LBound(Ary, 2)
Last = UBound(Ary, 2)

For i = First To Last - 1
    For j = i + 1 To Last
        If Ary(Col, i) > Ary(Col, j) Then

            Temp1 = Ary(1, j)
            Temp2 = Ary(2, j)

            Ary(1, j) = Ary(1, i)
            Ary(2, j) = Ary(2, i)

            Ary(1, i) = Temp1
            Ary(2, i) = Temp2

        End If
    Next j
Next i
End Sub

Answer 2

С Word вы не хотите RegEx, потому что это не будет уважать или разрешать форматирование.Функция подстановки в Word похожа, но не одинакова ...

Поскольку проверить это проще, я сделал это для вас в VBA.Вам нужно будет внести небольшие изменения (например, добавив wdAppp, где это необходимо), чтобы запустить его в VB.NET.

Поскольку необходимо проверить, содержат ли пара начальных и конечных скобок дополнительные стартовые скобки, невозможно использовать Replace.Поэтому после каждого успешного «поиска» код проверяет наличие открывающих скобок.Поскольку всегда будет один экземпляр, тест выполняется в цикле.

В тесте используется Instr для определения положения открывающей скобки.Для второго и любых последующих случаев позиция Start для Range устанавливается на экземпляр открывающей скобки.Как только больше ничего не найдено, подсветка применяется, диапазон свернут, и Find снова выполняется в цикле.

Я помещаю тест в отдельную функцию, позволяющую 1) проверить любой символ (например, волнистые скобки или круглые скобки) и 2) возвращают количество экземпляров в случае, если это будет представлять какой-либо интерес.

Sub FindSquareBracketPairs()
    Dim rngFind As Word.Range
    Dim sOpen As String, sClose As String
    Dim sFindTerm As String
    Dim bFound As Boolean, lPosOpen As Long

    Set rngFind = ActiveDocument.content
    sOpen = "["
    sClose = "]"
    sFindTerm = "\[*\]"

    With rngFind.Find
        .ClearFormatting
        .text = "\[*\]"
        .Forward = True
        .wrap = Word.WdFindWrap.wdFindStop
        .MatchWildcards = True
        bFound = .Execute

        Do While bFound
            lPosOpen = NumberOfCharInRange(rngFind, sOpen)
            rngFind.HighlightColorIndex = Word.WdColorIndex.wdYellow
            rngFind.Collapse wdCollapseEnd
            bFound = .Execute
        Loop
    End With

End Sub

'Checks whether there's more than one instance of searchTerm in the rng.Text
'For each instance above one, move the Start point of the range
'To the position of that instance until no more are "found".
'Since the Range is passed ByRef this will change the original
'range's position in the calling procedure.
Function NumberOfCharInRange(ByRef rng As Word.Range, _
                             ByRef searchTerm As String) As Long
    Dim lCountChars As Long, lCharPos As Long
    Dim s As String

    s = rng.text
    Do
        lCharPos = InStr(s, searchTerm)
        If lCharPos > 1 Then
            lCountChars = lCountChars + 1
            rng.Start = rng.Start + lCharPos
        End If
            s = Mid(s, lCharPos + 1)
    Loop Until lCharPos = 0
    NumberOfCharInRange = lCountChars
End Function