vbams-wordobject-reference

Infinite Loop in VBA WORD code due to Set statement


I wrote a simple code in VBA for MS WORD, in which I want to add dot at the end of each paragraph that has no dot.

The code is as follows:

Function FindParagraph(ByVal doc As Document, ByVal Npara As String) As Paragraph
    Dim para As Paragraph
    
    For Each para In doc.Paragraphs
        If para.Range.ListFormat.ListString = Npara Then
            Set FindParagraph = para
        End If
    Next para
End Function

Sub End_para_with_dot()
    Dim doc As Document
    Dim tb As table
    Dim prange As Range
    Dim srange As Range
    Dim para As Paragraph
    Dim spara As Paragraph
    Dim epara As Paragraph
    Dim txt As String
    
    Set doc = ActiveDocument
    
    Set spara = FindParagraph(doc, "1") 
    Set epara = FindParagraph(doc, "2")
    Set srange = doc.Range(spara.Range.Start, epara.Range.Start) 'sets a specific range of paragraphs in doc
    
    For Each para In srange.Paragraphs
        Set prange = para.Range
        With prange
            If .Style <> "Nagłówek 1" Then
                Debug.Print .Text
                txt = Trim(.Text)
                n = Len(txt)
                last_c = Mid(txt, n - 1, 1)
                If last_c <> "." Then
                    txt = Left(txt, n - 1) & "." & Chr(13)
                    Debug.Print txt
                End If
                .Text = txt '!!!SUPPOSED REASON FOR ERROR!!!
            End If
        End With
    Next para
End Sub

Unfortunately, after I run this code an infinite loop is produced with the first found paragraph being print all the time.

I suppose that it is due to .Text = txt line. Earlier I made a reference to the range object in this statement Set prange = para.Range. But I do not understand why when I want to reassign the .Text property of this object then the infinite loop is produced.

I would be grateful for any tip.


Solution

  • I'm assuming you don't want to add a . when the paragraph ends with any of !.,:;?

    Try a wildcard Find/Replace, where:

    Find = ([!\!.,:;\?])(^13)
    Replace = \1.\2
    

    Or, as a macro:

    Sub Demo()
    Application.ScreenUpdating = False
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "([!\!.,:;\?])(^13)"
        .Replacement.Text = "\1.\2"
        .Format = False
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
      End With
    End With
    Application.ScreenUpdating = True
    End Sub