VBA Word - условно принимать изменения в верхних и нижних колонтитулах

Question

Я пишу сабвуфер, который очищает документ 'Tracked Changes' из-за различного уровня владения MS-Word в наших командах Tech-Writing и Eng Review.

В основномС обратной стороны события Document_Open я перебираю все StoryRanges , проверяя Revision.Type и либо Принимаю или Ничего не делать на основеперечисляемое значение (.Type <> 1, 2 или 9) изменения.Я также делаю это для обоих Верхних колонтитулов и Нижних колонтитулов в документе.

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

'Public Declarations
Public Sctn as Section
Public NewRevision as Revision
Public StorySect as Object
Public HdFt as HeaderFooter'

'Conditionlly Accept Changes in Document
    Public Sub Document_AcceptAll()

    On Error GoTo RevErr

    'Body
    For Each StorySect In ActiveDocument.StoryRanges 
        For Each NewRevision In ActiveDocument.Revisions
            Select Case ThisDocument.NewRevision.Type
                Case Is <> 1, 2 Or 9    '1: wdRevisionInsert  2: wdRevisionDelete  9: wdRevisionReplace
                    ThisDocument.NewRevision.Accept

                Case Else

            End Select

        Next NewRevision
    Next StorySect '<<

    'Header & Footers
    With ActiveDocument
        'Loop thru all Sections
        For Each Sctn In .Sections
            'Loop thru all Headers in Section
            For Each HdFt In Sctn.Headers
                With HdFt
                    For Each NewRevision In ActiveDocument.Revisions                            
                        Select Case ThisDocument.NewRevision.Type
                            Case Is <> 1, 2 Or 9    '1: wdRevisionInsert  2: wdRevisionDelete  9: wdRevisionReplace
                                ThisDocument.NewRevision.Accept
                            Case Else
                        End Select
                    Next NewRevision
                End With
            Next HdFt

            'Loop thru all Footers in Section
            For Each HdFt In Sctn.Footers
                With HdFt
                    For Each NewRevision In ActiveDocument.Revisions
                        Select Case ThisDocument.NewRevision.Type
                            Case Is <> 1, 2 Or 9    '1: wdRevisionInsert  2: wdRevisionDelete  9: wdRevisionReplace
                                ThisDocument.NewRevision.Accept
                            Case Else
                        End Select
                        Next NewRevision
                  End With    
            Next HdFt

        Next Sctn
    End With

lbl_Exit:
        Exit Sub
RevErr:
        If Err.Number <> 5852 Then
            Err.Clear
            GoTo lbl_Exit
        Else
            Err.Clear
            Resume
        End If
    End Sub

Простым решением было бы просто игнорировать его до финальной публикации и запустить подпрограмму AcceptAll, но тогда я теряю бары изменений и не думаю, что смогу получить повторяемый результат, если команде было порученовручную добавьте бары изменений.

Похоже, есть другой подход: создать цикл SeekView для каждого раздела, а затем вложить условный Revision.Type, но кажется, что он избыточен для этого приложения.

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

https://docs.microsoft.com/en-us/office/vba/api/word.wdrevisiontype

Принимать изменения форматированияв верхних и нижних колонтитулах Word и основном документе

Answer 1

Причина, по которой указанный код не собирает какие-либо изменения в верхних и нижних колонтитулах, заключается в том, что в идеале Revisions следует запрашивать в диапазоне , а не только в ActiveDocument или Headerили Footer.Первый случай, кажется, работает для вас, по крайней мере, на тестируемых документах, хотя я ожидаю, что он пропустит любые изменения в текстовых полях.

Кроме того, должна быть возможность подобрать заголовки инижние колонтитулы по циклу StoryRanges.См. Последний пример в документации .Код, указанный в вопросе, отсутствует в цикле NextStoryRange.

Следующий фрагмент кода демонстрирует оба предложения.Revisions запрашивается у StoryRange, а код циклически повторяется all StoryRanges в документе.(Обратите внимание, что «в реальном мире» я бы, вероятно, поместил код, повторяющийся внутри цикла, в отдельную процедуру и вызвал бы эту процедуру в обоих местах, а не дублировал весь код.)

Public Sub Document_AcceptAll()

'Public Declarations
    Dim Sctn As Section
    Dim NewRevision As Revision
    Dim StorySect As Word.Range
    Dim HdFt As HeaderFooter

    On Error GoTo RevErr

    For Each StorySect In ActiveDocument.StoryRanges
        'Debug.Print StorySect.StoryType
        For Each NewRevision In StorySect.Revisions
            Select Case NewRevision.Type
                Case Is <> 1, 2 Or 9    '1: wdRevisionInsert  2: wdRevisionDelete  9: wdRevisionReplace
                    NewRevision.Accept

                Case Else

            End Select

        Next NewRevision
        Do While Not (StorySect.NextStoryRange Is Nothing)
            Set StorySect = StorySect.NextStoryRange

            For Each NewRevision In StorySect.Revisions
                Select Case NewRevision.Type
                    Case Is <> 1, 2 Or 9    '1: wdRevisionInsert  2: wdRevisionDelete  9: wdRevisionReplace
                        NewRevision.Accept

                    Case Else

                End Select

            Next NewRevision
        Loop
        Next StorySect '<<

lbl_Exit:
        Exit Sub
RevErr:
        If Err.Number <> 5852 Then
            Err.Clear
            GoTo lbl_Exit
        Else
            Err.Clear
            Resume
        End If
End Sub