Microsoft Office Forums - View Single Post

gmayor · 03-07-2020, 01:10 AM

Bearing in mind that your idea of what constitutes a 'word' and what VBA considers is a word may not coincide. The following will split the paragraphs into 50 'word' segments.

Code:

Sub DeleteTextBetweenTwoWords()

'Graham Mayor - https://www.gmayor.com - Last updated - 07 Mar 2020 

Dim strFirstWord As String
Dim strLastWord As String
Dim objDoc As Document
Dim lngPara As Long
Dim oRng As Range

    Set objDoc = ActiveDocument
    strFirstWord = "T:"
    strLastWord = "P:"

    With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = strFirstWord & "*" & strLastWord
            .Replacement.Text = strLastWord
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End With

    For lngPara = objDoc.Paragraphs.Count To 1 Step -1
        Set oRng = objDoc.Paragraphs(lngPara).Range
        If oRng.Words.Count > 50 Then
            SplitString oRng
        End If
    Next lngPara

    With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "%%%%"
            .Replacement.Text = "^p"
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End With
lbl_Exit:
    Set objDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Private Sub SplitString(oRng As Range)
'Graham Mayor - https://www.gmayor.com - Last updated - 07 Mar 2020 

Dim i As Integer
Dim oSplit As Range
    Set oSplit = oRng
    Do
        oSplit.MoveStart wdWord, 50
        If Len(oSplit) < 51 Then GoTo lbl_Exit
        oSplit.InsertBefore "%%%%"
    Loop
lbl_Exit:
    Set oSplit = Nothing
    Exit Sub
End Sub