在不更改应用段落样式的情况下将单词修订拆分为多个修订

时间:2019-02-01 10:34:34

标签: vba ms-word

是否有直接的方法可以将单词修订分为一组修订?

如果不能,在这种情况下, enter image description here 这与my other issue有关。

该文档有几个段落,每个段落都有自己的应用样式。 在上面的示例中使用插入的修订时,我想用插入段落结束标记将修订分开,因为它将分成三个修订。解决方案应该是一个全局解决方案,无论用户做什么,都可以申请任何插入。 例如:

  • 插入内容中可以包含任意数量的段落结束标记。
  • 插入可以以段落结束标记开头
  • 段落采用了单独的段落样式,我们需要保持不变。

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

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

有人可以帮助我吗?

谢谢。

1 个答案:

答案 0 :(得分:0)

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

对此代码段的任何改进都表示赞赏。

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