Split a word revision into revisions without changing applied paragraph styles

Question

Is there a direct way that we can split a word revision in to set of revisions?

If cannot, In this below case, This is related to my other issue.

The document has several paragraphs with each has its own applied style. When take the inserted revision in the above example, I want to separate the revision by the inserted paragraph ending marks as then it will split into three revisions. And the solution should be a global solution which can be able to apply for any insertion whatever the user does. For example :

Insertion can contain any number of paragraph ending marks within it.
Insertion can start with a paragraph ending mark
Paragraphs has separate paragraph styles applied and we need to keep them unchanged.

This is the code I have modified,I tried to separate the first paragraph and other paragraphs. But, I have stuck in the logic part.

Private Function RemoveParagraphEndingsFromRevisions(ByRef WordRange As Word.Range)
On Error GoTo ErrorHandler

Dim fTrackRevisions As Boolean
Dim objRevision As Word.Revision
Dim objRange1, objRange2 As Word.Range
Dim sPara, firstParaStyle As String
Dim stylesCollection As VBA.Collection
Dim count As Long

Set stylesCollection = New VBA.Collection
sPara = vbCr
With WordRange.Document
    fTrackRevisions = .TrackRevisions
    .TrackRevisions = False
End With

For Each objRevision In WordRange.Document.Revisions
    'AllowTrackChangesForInsertion method checks whether the revision contains a text change
    If AllowTrackChangesForInsertion(objRevision) = True Then
        'If there are paragraph ending marks within the revision
        If InStr(objRevision.Range.Text, sPara) > 0 Then
            Set objRange1 = objRevision.Range.Duplicate
            Set objRange2 = objRange1.Duplicate

            firstParaStyle = objRange2.Paragraphs(1).Style

            If (objRange1.Paragraphs.count > 1) Then
                count = 2
                Do While (count < objRange1.Paragraphs.count + 1)
                    stylesCollection.Add objRange1.Paragraphs(count).Style
                    count = count + 1
                Loop

                .........

            Else
                'When there's no inserted text after inserted end para mark
            End If

        End If
    End If
Next

ErrorHandler:
    WordRange.Document.TrackRevisions = fTrackRevisions
    Set objRevision = Nothing
    Set objRange1 = Nothing
    Set objRange2 = Nothing
    Set stylesCollection = Nothing
    Select Case Err.Number
        Case 0
        Case Else
            ShowUnexpectedError ErrorSource:="RemoveParasFromRevisions" & vbCr & Err.Source
    End Select
End Function

Could anybody please help me with this.

Thank you.

ApsSanj ApsSanj · Accepted Answer · 2019-02-06T16:03:56

I have able to implement a code that split a revision into revisions when have paragraph ending marks within it along with there applied styles.

Any improvements for this code snippet are really appreciated.

Private Function RemoveParagraphEndingsFromRevisions(ByRef WordRange As Word.Range)
On Error GoTo ErrorHandler

Dim fTrackRevisions As Boolean
Dim objRevision As Word.Revision
Dim objRange1 As Word.Range
Dim sPara As String
Dim firstParaStyle As String
Dim objParagraph As Word.Paragraph

sPara = vbCr
With WordRange.Document
    fTrackRevisions = .TrackRevisions
    .TrackRevisions = False
End With

For Each objRevision In WordRange.Document.Revisions
    If AllowTrackChangesForInsertion(objRevision) = True Then
        'does the revision contains paragraph ending marks within it
        If InStr(objRevision.Range.Text, sPara) > 0 Then
            Set objRange1 = objRevision.Range.Duplicate

            Set objParagraph = objRange1.Paragraphs.First
            'Get the styles of the first paragraph of the revision
            firstParaStyle = objRange1.Paragraphs.First.Style

            objParagraph.Range.Collapse wdCollapseEnd
            'Insert another paragraph as "buffer"
            objParagraph.Range.InsertAfter sPara
            'Ensure the first paragraph has its original style
            objRange1.Paragraphs.First.Style = firstParaStyle
            'Delete the "buffer" paragraph
            objParagraph.Range.MoveStart wdCharacter, 1
            objParagraph.Range.Characters.Last.Delete

        End If
    End If
Next

ErrorHandler:

    WordRange.Document.TrackRevisions = fTrackRevisions
    Set objRevision = Nothing
    Set objRange1 = Nothing
    Set objParagraph = Nothing
    Select Case Err.Number
        Case 0
        Case Else
            ShowUnexpectedError ErrorSource:="RemoveParasFromRevisions" & vbCr & Err.Source
    End Select
End Function

Split a word revision into revisions without changing applied paragraph styles

1 Answers