将单词修订拆分为修订而不更改应用的段落样式答案

【问题标题】：Split a word revision into revisions without changing applied paragraph styles将单词修订拆分为修订而不更改应用的段落样式
【发布时间】：2019-02-07 00:03:56
【问题描述】：

有没有一种直接的方法可以将单词修订拆分为一组修订？

如果不能，在下面这种情况下，这与my other issue 有关。

文档有几个段落，每个段落都有自己的应用风格。当在上面的例子中插入修订时，我想用 inserted 段落结束标记分隔修订，因为它会分成三个修订。并且该解决方案应该是一个全局解决方案，无论用户做什么都可以申请任何插入。例如：

插入可以包含任意数量的段落结束标记。
插入可以以段落结尾标记开始
段落应用了单独的段落样式，我们需要保持它们不变。

这是我修改的代码，我尝试将第一段和其他段落分开。但是，我一直停留在逻辑部分。

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

谁能帮我解决这个问题。

谢谢。

【问题讨论】：

标签： vba ms-word

【解决方案1】：

当其中包含段落结束标记以及应用的样式时，我能够实现将修订拆分为修订的代码。

非常感谢对此代码 sn-p 的任何改进。

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

【讨论】：