Question

我正在使用VBA更改“已应用单词跟踪更改”文档。

红色的段落结束标记是插入的段落结束标记。（启用“音轨更改”>将光标放在第一段的末尾>按Enter>插入新的段落内容>格式）风格不同

我需要为带有文本“ Insertion” +插入文本的插入添加一个字段。（此过程中的输出文档还要经过其他一些过程（VBA中没有），因此为了使其他过程“这是一个插入”，我们正在添加该字段）

Public Sub main()

Dim objRange As Word.Range

Set objRange = Word.ActiveDocument.Range

TrackInsertions objRange

End Sub

Public Sub TrackInsertions(WordRange As Word.Range)
    Dim objRevision As Word.Revision
    Dim objContentControl As Word.ContentControl
    Dim objRange As Word.Range
    With WordRange
       For Each objRevision In .Revisions
           If AllowTrackChangesForInsertion(objRevision) = True Then
              On Error Resume Next
              With objRevision
                  Set objRange = .Range
                  .Range.Font.Underline = wdUnderlineSingle
                  .Range.Font.ColorIndex = wdRed
                  Set objField = objRange.Fields.Add(Range:=objRange, Type:=wdFieldComments, Text:="Insertion " + objRange.Text, PreserveFormatting:=False)
                  .Accept
              End With
              Err.Clear

          End If
        Next objRevision
    End With

    End Sub

Private Function AllowTrackChangesForInsertion(ByRef Revision As Word.Revision) As Boolean
    With Revision
        Select Case .Type
            Case wdRevisionInsert, wdRevisionMovedFrom, wdRevisionMovedTo, wdRevisionParagraphNumber, wdRevisionStyle
                AllowTrackChangesForInsertion = IsTextChangeExist(.Range)
            Case Else
                AllowTrackChangesForInsertion = False
        End Select
    End With
End Function

Private Function IsTextChangeExist(ByRef Range As Word.Range) As Boolean
'False if the range contain inlineshapes, word fields and tables
    Select Case True
        Case Range.InlineShapes.Count > 0
            IsTextChangeExist = False
        Case Range.Fields.Count > 0
            IsTextChangeExist = False
        Case Range.Tables.Count > 0
            IsTextChangeExist = False
        Case Else
            IsTextChangeExist = True
    End Select
End Function

问题是，当进行上述更改时，第二段带有插入的文本（我不在此处将段落结尾标记视为段落）第一段变成了一个段落。在此代码部分中，实际的段落数减少了，最后的输出（在通过其他应用程序运行之后）还包含减少的段落数，这就是问题所在。

当我们阅读修订版本时，红色段落结束标记+第二段作为一个修订版本。即使该修订版有多个段落，也只能作为一个修订版。如果我们对插入的段落应用了单独的段落样式，则在运行此代码后，修订版将获得一种样式，即立即段落的样式。这一切都是由于 插入的段落结束标记 引起的。

我尝试遍历段落一词，因为我想要避免更改文档中的段落数。（尝试从下至上，从下至上）但这并不能解决我的问题。

我还尝试将修订版分为两个修订版，

 If objParagraph.End < objRevision.Range.End Then
     .....
 End If

但是我无法将范围应用于新修订版。

现在，如果我们在内容中识别出段落结束标记，然后将其分开应用，我想将修订分为几部分如果可能的话，向他们发送字段。因此，添加字段后，段落计数和段落样式都不会改变。

或者，是否有办法接受所有标记为插入到Word文档中的段落结束标记（仅）？

有人可以帮助我继续进行代码吗？如果您有其他想法，请告诉我。

谢谢。

Answer 1

在音轨更改为 off 的情况下，以下代码示例循环Revisions并检查第一个字符是否为段落标记。如果是...

实例化了两个Range对象，一个用于在段落更改期间插入的对象之前的段落，另一个用于进行跟踪更改的对象。这是必要的，因为在代码进行更改时Revision.Range无效。这两个段落的样式均已注明。

然后在第一个段落之后立即插入一个附加段落，这会将两个段落从修订版中删除。正确的样式将应用于第一段和曲目更改段，然后删除多余的插入段。

Option Explicit

Sub RemoveParasFromRevisions()
    Dim doc As word.Document
    Dim rev As word.Revision, rng As word.Range, rngRev As word.Range
    Dim sPara As String, sStyleOrig As String, sStyleRev As String

    sPara = vbCr
    Set doc = ActiveDocument
    doc.TrackRevisions = False
    For Each rev In doc.Revisions
        'If the start of the Revision is a paragraph mark
        If InStr(rev.Range.text, sPara) = 1 Then
            'Get ranges for the revision as the original revision
            'will no longer be available after the changes made
            Set rngRev = rev.Range.Duplicate
            Set rng = rngRev.Duplicate

            'Get the styles of the first paragraph and last paragraph
            sStyleRev = rngRev.Paragraphs.Last.style
            sStyleOrig = rng.Paragraphs(1).style

            'Make sure the revision range is beyond the previous paragraph
            rngRev.Collapse wdCollapseEnd
            'Make sure the range for the previous paragraph is outside the revision
            rng.Collapse wdCollapseStart
            'Insert another paragraph as "buffer"
            rng.InsertAfter sPara
            'Ensure the first paragraph has its original style
            rng.Paragraphs(1).Range.style = sStyleOrig
            'And the revision the style applied to the text while track changes was on
            rngRev.style = sStyleRev
            'Delete the "buffer" paragraph
            rng.MoveStart wdCharacter, 1
            rng.Characters.Last.Delete
        End If
    Next

    'Test it
'    Dim counter As Long
'    For Each rev In doc.Revisions
'        counter = counter + 1
'        Debug.Print rev.Range.text, counter
'    Next
'    Debug.Print doc.Revisions.Count
End Sub

应用于Word版本的更改使两个段落变成一个段落

1 个答案: