Изменения, примененные к ревизии Word, превращают два абзаца в один

Question

Я делаю изменения в документе «изменения слов применяются», используя VBA.

Красной конечной меткой абзаца является вставленный конечный знак абзаца (сделать «изменения дорожки ВКЛ»> поставить курсор в конец первого абзаца> Нажмите Enter> Вставить новое содержание абзаца> отформатируйте в другом стиле)

Мне нужно добавить поле для вставок с текстом «Вставка» + вставленный текст.(Выходной документ в этом процессе проходит через некоторые другие процессы (не в 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

Но яЯ не могу применить диапазон к новой ревизии.

Теперь я хочу разделить ревизию на части, если мы определили конечный знак абзаца внутри содержимого, и по возможности применить к ним отдельные поля.Таким образом, количество абзацев и стили абзацев не будут изменены после добавления полей.

Или, есть ли способ принять все конечные метки абзаца (только), которые помечены как вставленные в текстовый документ?

Может кто-нибудь помочь мне продолжить работу с кодом, скажите, пожалуйста,я, если у вас есть другие идеи.

Заранее спасибо.

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