View Single Post
 
Old 11-13-2021, 06:54 PM
John O'Rourke John O'Rourke is offline Windows 10 Office 2019
Novice
 
Join Date: Nov 2021
Posts: 6
John O'Rourke is on a distinguished road
Smile Latest and Greatest

I decided that there is a problem in the VBA word handling of for each p in doc.paragraphs and the for each sn in p.range.sentences. When you insert vbcr the number of paragraphs increases and the number of total sentences decreases. It thinks you are in the next paragraph sort of but its first sentence is the last sentence of the prior paragraph. I decided to abandon for each method and use set p=doc.paraphs(i)
and just increment i by hand and read the next paragraph as if I were processing a file. Then I can completely control the positioning, characters, sentences and go through the document quickly and accurately. I don't now get short sentences inside each paragraph but there may be a couple of short sentences as the last sentence. This may require playing with various cutoffs to get something that handles most conditions but I like what I have now. For those of you that shudder at gotos please don't look at the code.

Code:
Sub insertp()

Dim doc As Document
Dim p As Paragraph
Dim sn As Variant
Dim ts As Long
Dim tc As Long
Dim i As Long

Set doc = ActiveDocument

Application.ScreenUpdating = False

i = 0
GoTo NextParagraph

ProcessPara:

        Set sn = p.Range.Sentences(ts)
        tc = tc + Len(sn)
           
        If tc >= 300 And ts < p.Range.Sentences.Count Then
            p.Range.Sentences(ts).InsertAfter vbCr
            GoTo NextParagraph
        End If
        
        ts = ts + 1
        If ts < p.Range.Sentences.Count Then
            GoTo ProcessPara
        End If
        
NextParagraph:

    i = i + 1
    If i <= doc.Paragraphs.Count Then
        Set p = doc.Paragraphs(i)
        If p.Range.Sentences.Count > 0 And p.Range.Characters.Count > 450 Then
            ts = 1
            tc = 0
         GoTo ProcessPara
        Else
            GoTo NextParagraph
        End If
    End If
    
Application.ScreenUpdating = True

End Sub
Reply With Quote