括号中的 Word VBA 宏

Question

我一直在使用以下宏将括号中的项目提取到 word 中的评论中：

'
' CommentBubble Macro
'
'
Dim myRange As Range
Set myRange = ActiveDocument.Content
searchtext = "\(*\)"

With myRange.Find
    .MatchWildcards = True
    Do While .Execute(findText:=searchtext, Forward:=True) = True
      If Len(myRange.Text) > 4 Then
        ActiveDocument.Comments.Add myRange, myRange.Text
        myRange.Text = ""
      End If
    Loop
 End With
End Sub

我将文本长度设置为 > 4 的原因是因为这些是法律文件，我不想在以下条件下隔离具有类似 " 的字符串：(i) 条件 1，(ii) ) 条件 2 等"

但是，上面的代码中断了一段文本：

This is sample text (with some additional text) that does stuff (with more stuff) and represents 39.4% of shares on the effective date (before giving effect, with some conditions such as ( some stuff (i) and some stuff (ii) with final stuff) and more final stuff) which is subject to  (some conditions here) and conclude here.

如果你运行这个你会得到以下结果：

This is sample text  that does stuff  and represents 39.4% of shares on the effective date  and some stuff (ii) with final stuff) and more final stuff) which is subject to   and conclude here.

如您所见，嵌套的括号引起了一些麻烦。有什么建议吗？

谢谢！

Answer 1

您正在尝试匹配括号，这在 Word 中是一项艰巨且吃力不讨好的任务，因为 Word 仅将左括号和右括号视为单独的字符，而不会按单词自动匹配。下面的代码找到匹配的括号，消除尾随空格，处理没有括号的情况，并在出现不平衡错误时出错。我留在调试语句中，以便您可以取消注释它们以查看发生了什么。

Option Explicit

Public Sub ttest()

    Dim myRange As Word.Range
    Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
    myRange.Collapse direction:=wdCollapseStart
    
    
    Set myRange = NextParenRange(myRange)
    
    Do Until myRange Is Nothing
    
        DoEvents
        
        Debug.Print myRange.Text
        Dim myDupRange As Word.Range
        Set myDupRange = myRange.Duplicate
        myRange.Collapse direction:=wdCollapseEnd
        If myDupRange.Characters.Last.Next.Text = " " Then myDupRange.MoveEnd Count:=1
        myDupRange.Delete
        Set myRange = NextParenRange(myRange)
        
    
    Loop
    
End Sub

Public Function NextParenRange(ByVal ipRange As Word.Range) As Word.Range

    Const OpenP As String = "("
    Const CloseP As String = ")"
    
    Dim myRange As Word.Range
    Set myRange = ipRange.Duplicate
    
    'If myRange.Start <> myRange.End Then myRange.Collapse direction:=wdCollapseStart
    
    'exit if no parentheses exist
    'Debug.Print myRange.Start
    If myRange.MoveUntil(cset:=OpenP) = 0 Then
    
        Set NextParenRange = Nothing
        Exit Function
        
        
    Else
    
        'Debug.Print myRange.Start
        Dim myParenCount As Long
        myParenCount = 1
        myRange.MoveEnd Count:=1

    End If
    
    
    Do Until myParenCount = 0
    
        ' allows VBA to respond to a break key press
        DoEvents
        
        ' if we run out of parentheses before we get back to zero then flag an error
        If myRange.MoveEndUntil(cset:=OpenP & CloseP) = 0 Then
        
            VBA.Err.Raise 17, "Unbalanced parentheses in document"
            
            
        End If
        
        myRange.MoveEnd Count:=1
        'Debug.Print myRange.Characters.Last.Text
        'Debug.Print myRange.Characters.Last.Next.Text
        myParenCount = myParenCount + IIf(myRange.Characters.Last.Text = OpenP, 1, -1)
        
    
    Loop
    
    Set NextParenRange = myRange.Duplicate
    
End Function

括号中的 Word VBA 宏

Word VBA macro on parentheticals

vba

ms-word