由于 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
我在 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