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.
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