由于 Set 语句,VBA WORD 代码中的无限循环

Infinite Loop in VBA WORD code due to Set statement

我在 VBA 中为 MS WORD 写了一个简单的代码, 我想 在每个没有点的段落末尾添加点 .

代码如下:

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

不幸的是,在我 运行 这段代码之后,产生了一个无限循环,第一个找到的段落一直在打印。

我想这是由于 .Text = txt 行。早些时候我在这个语句 Set prange = para.Range 中引用了 range 对象。但是我不明白为什么当我想重新分配这个对象的.Text 属性时会产生无限循环。

如有任何提示,我将不胜感激。

我假设您不想添加 .当段落以 !.,:;?

中的任何一个结尾时

尝试使用 通配符 Find/Replace,其中:

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

或者,作为宏:

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