Macro de VBA do Word em parênteses delimitadores

Question 1

Tenho vindo a utilizar a macro a seguir para retirar itens entre parênteses para comentários no 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

A razão de eu ter o comprimento do texto a ser > 4 é porque estes são documentos legais e eu não quero isolar seqüências de caracteres que tem coisas como "nas seguintes condições: (i) condição 1, (ii) condição 2, etc."

No entanto, aqui está um trecho do texto para que o código acima quebras de:

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.

Se você executar isso, você vai obter o seguinte resultado:

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.

Como você pode ver o parênteses aninhados causar alguns problemas. Algum conselho?

Obrigado!

Question 2

Você está tentando corresponder parênteses que no Word é uma tarefa difícil e ingrata tarefa como o Word só vê a abertura e fechamento de parênteses, como caracteres individuais e não correspondidos automaticamente pelo word. O código abaixo encontra correspondência entre parênteses, elimina espaços à direita, habdles o caso de não parênteses estar presente, e os erros se você tem desequilibrado erros. Eu deixei em instruções de depuração, de modo que você pode descomente-los para ver o que está acontecendo.

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

freeflow · Answer 1 · 2021-11-21T14:57:37

Você está tentando corresponder parênteses que no Word é uma tarefa difícil e ingrata tarefa como o Word só vê a abertura e fechamento de parênteses, como caracteres individuais e não correspondidos automaticamente pelo word. O código abaixo encontra correspondência entre parênteses, elimina espaços à direita, habdles o caso de não parênteses estar presente, e os erros se você tem desequilibrado erros. Eu deixei em instruções de depuração, de modo que você pode descomente-los para ver o que está acontecendo.

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

@freeflow: Qualquer sugestão de como alterar o código para funcionar com uma selecção específica só? Eu mudei Set myRange = Selection.StoryRanges(wdMainTextStory) mas isso não parece suficiente.
Você vai precisar fazer duas coisas. Alterar 'Definir myRange = ActiveDocument.StoryRanges(wdMainTextStory)' para 'Definir myRange=seleção.Intervalo'. Você também vai precisar de capturar a fim de myrange em uma área separada variável e, em seguida, no loop do until teste que o atual início do intervalo não é mais do que o salvou final do intervalo. por exemplo, algo como 'Fazer até myRange.início>=mySavedEnd'

Macro de VBA do Word em parênteses delimitadores

Pergunta

Melhor resposta

Em outros idiomas

Esta página está em outros idiomas

Popular nesta categoria

Perguntas populares nesta categoria