VBA或VB.NET MS Word在嵌套括号中突出显示文本

时间:2018-10-18 13:54:51

标签: vba vb.net ms-word

我试图弄清楚如何在Word文档中突出显示带括号的文本,但是它具有嵌套的括号。我可以通过打开和关闭字符跟踪括号来遍历整个文档字符,但这在大型文档中效率不高。我想强调嵌套括号的另一种颜色。

[一些文本突出显示为黄色[其他突出显示为绿色],另一些文本突出显示为黄色[另一项突出显示为绿色],然后其余突出显示为黄色]

我最初使用的是该版本(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的事情,但是我真的不熟悉RegEx,似乎无法绕过它们。同样,您似乎也必须知道“嵌套”级别的数量才能编写正确的正则表达式,而我也不会总是知道这一点。

2 个答案:

答案 0 :(得分:0)

使用Word,您不想要RegEx,因为它不尊重或不允许格式化。 Word的通配符功能相似,但不相同...

由于测试更加简单,因此我已经在VBA中为您完成了此任务。您需要进行一些小的更改(例如,在必要时添加wdAppp)才能在VB.NET中运行它。

由于必须测试首尾括号对是否包含其他首尾括号,因此无法使用Replace。因此,在每个成功的“查找”之后,代码将测试是否存在方括号。由于总会有一个实例,因此测试是循环执行的。

测试使用Instr来获取开括号的位置。对于第二个及以后的实例,Start的{​​{1}}位置设置为右括号的实例。一旦找不到更多内容,将应用突出显示,然后折叠范围,并在循环中再次执行Range

我将测试放在一个单独的函数中,可以进行以下操作:1)测试任何字符(例如,方括号或括号),以及2)返回实例数,以防万一。 >

Find

答案 1 :(得分:0)

谢谢Cindy Meister,您的代码对我来说是个很好的起点。它对于获取嵌套的括号非常有用,但不会突出显示括号中的信息。我终于想出了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