应用于 Word 修订版的更改使两段合二为一 [英] Changes applied to a Word revision make two paragraphs into one

问题描述

我正在使用 VBA 对应用的文字跟踪更改"文档进行更改.

I am doing changes to a 'word track changes applied' document using VBA.

红色段落结束标记是插入段落结束标记.(打开跟踪更改">将光标放在第一段的末尾>按Enter>插入新段落内容>格式风格不同)

The red colored paragraph ending mark is a inserted paragraph ending mark.(Make 'track changes ON' > put cursor at the end pf first paragraph > Press Enter > Insert the new paragraph content > format with a different style)

我需要为带有文本插入"+ 插入文本的插入添加一个字段.(这个过程中的输出文档经过了一些其他的过程(不是在 VBA 中)，所以为了让其他进程这是一个插入"，我们正在添加该字段)

I need to add a field for the insertions with text "Insertion" + inserted text. (The output document in this process goes through some other processes(not in VBA), so in order to let that other processes "That is an insertion", we are adding that field)

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

问题是，当上面改变时，插入文本的第二段(我这里不把段落结束标记算作段落)并且第一段变成了一段.在此代码部分中，实际段落数减少了，最终输出(在运行其他应用程序之后)还包含减少的段落数，这就是问题所在.

The issue is, when do the above change, the second paragraph with inserted text (I am not counting the paragraph ending marks as paragraphs here) and the first paragraph has turned into one paragraph. As within this code part, actual paragraph count get reduced, the final output (after run through other application) also contains the reduced paragraphs count, which is the issue.

当我们通读修订时，红色段落结束标记+第二段作为一个修订.即使该修订有多个段落，它也作为一个修订.如果我们对插入的段落应用了单独的段落样式，运行此代码后，修订版得到一种样式，立即段落的风格.这一切都是因为插入的段落结束标记.

When we read through the revisions, red colored paragraph ending mark + second paragraph goes as one revision. Even that revision has multiple paragraphs, it goes as one revision. If we have applied seperate paragraph styles to the inserted paragraphs, after run through this code, the revision got one style, the immediate paragraph's style. This all occurs because of that Inserted paragraph ending mark.

我尝试在单词段落中移动，因为我想要的是避免更改文档中的段落计数.(尝试自下而上，自下而上)但这并没有解决我的问题.

I tried moving through the word paragraphs, because what I want is to avoid changing the paragraphs count in the document. (tried bottom to up, up to bottom both )But that didn't solve my issue.

我也尝试将修订版分成两个修订版，当

Also I have tried to split the revision into two revisions, when

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

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

But I am unable to apply range to a new revision.

如果我们在内容中确定了段落结束标记，现在我想将修订分成几部分，并单独应用如果可能的话.所以段落计数和段落样式在添加字段后都不会改变.

Now I want to split the revision into parts if we identified a paragraph ending mark within the content, and apply separate fields to them, if possible. So the paragraph count nor the paragraph styles won't change after adding fields.

或者，有没有办法接受所有标记为插入到word文档中的段落结束标记(仅)?

Or, Is there a way to accept all paragraph ending marks(only) that are marked as inserted within a word document?

有人可以帮我继续代码吗，如果你有其他想法，请告诉我.

Could anybody please help me to proceed with the code, Please tell me if you got other ideas.

提前致谢.

推荐答案

With track changes off，以下代码示例循环 Revisions 并检查第一个字符是否为一个段落标记.如果是...

With track changes off, the following code example loops the Revisions and checks whether the first character is a paragraph mark. If it is...

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

Two Range objects are instantiated, one for the paragraph before the one inserted during track changes, another for the one that's a tracked change. This is necessary because Revision.Range becomes invalid when the code makes changes. The styles for both paragraphs are noted.

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

Then an additional paragraph is inserted immediately following the first one, which takes both paragraphs out of the Revision. The correct styles are applied to the first paragraph and the track changes paragraph, then the extra, inserted paragraph is removed.

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 修订版的更改使两段合二为一的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！