Макрос для обновления всех полей в текстовом документе

За эти годы я создал макрос vba, который должен обновлять все поля в текстовом документе.

Я вызываю этот макрос перед выпуском документа для проверки, чтобы убедиться, что все верхние и нижние колонтитулы и т. Д. Верны.

В настоящее время - это выглядит так:

Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
    Dim doc As Document ' Pointer to Active Document
    Dim wnd As Window ' Pointer to Document's Window
    Dim lngMain As Long ' Main Pane Type Holder
    Dim lngSplit As Long ' Split Type Holder
    Dim lngActPane As Long ' ActivePane Number
    Dim rngStory As Range ' Range Objwct for Looping through Stories
    Dim TOC As TableOfContents ' Table of Contents Object
    Dim TOA As TableOfAuthorities 'Table of Authorities Object
    Dim TOF As TableOfFigures 'Table of Figures Object
    Dim shp As Shape

    ' Set Objects
    Set doc = ActiveDocument
    Set wnd = doc.ActiveWindow

    ' get Active Pane Number
    lngActPane = wnd.ActivePane.Index

    ' Hold View Type of Main pane
    lngMain = wnd.Panes(1).View.Type

    ' Hold SplitSpecial
    lngSplit = wnd.View.SplitSpecial

    ' Get Rid of any split
    wnd.View.SplitSpecial = wdPaneNone

    ' Set View to Normal
    wnd.View.Type = wdNormalView

    ' Loop through each story in doc to update
    For Each rngStory In doc.StoryRanges
        If rngStory.StoryType = wdCommentsStory Then
            Application.DisplayAlerts = wdAlertsNone
            ' Update fields
            rngStory.Fields.Update
            Application.DisplayAlerts = wdAlertsAll
        Else
           ' Update fields
           rngStory.Fields.Update
            If rngStory.StoryType <> wdMainTextStory Then
                While Not (rngStory.NextStoryRange Is Nothing)
                    Set rngStory = rngStory.NextStoryRange
                    rngStory.Fields.Update
                Wend
            End If
        End If
    Next

    For Each shp In doc.Shapes
      If shp.Type <> msoPicture Then
        With shp.TextFrame
            If .HasText Then
                shp.TextFrame.TextRange.Fields.Update
            End If
        End With
      End If
    Next

    ' Loop through TOC and update
    For Each TOC In doc.TablesOfContents
        TOC.Update
    Next

    ' Loop through TOA and update
    For Each TOA In doc.TablesOfAuthorities
        TOA.Update
    Next

    ' Loop through TOF and update
    For Each TOF In doc.TablesOfFigures
        TOF.Update
    Next

    ' Header and footer too.
    UpdateHeader
    UpdateFooter

    ' Return Split to original state
    wnd.View.SplitSpecial = lngSplit

    ' Return main pane to original state
    wnd.Panes(1).View.Type = lngMain

    ' Active proper pane
    wnd.Panes(lngActPane).Activate

    ' Close and release all pointers
    Set wnd = Nothing
    Set doc = Nothing

End Sub

Sub UpdateFooter()
    Dim i As Integer

     'exit if no document is open
    If Documents.Count = 0 Then Exit Sub
    Application.ScreenUpdating = False

     'Get page count
    i = ActiveDocument.BuiltInDocumentProperties(14)

    If i >= 1 Then 'Update fields in Footer
        For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
         footer.Range.Fields.Update
        Next
    End If

    Application.ScreenUpdating = True
End Sub

 'Update only the fields in your footer like:
Sub UpdateHeader()
    Dim i As Integer

     'exit if no document is open
    If Documents.Count = 0 Then Exit Sub
    Application.ScreenUpdating = False

     'Get page count
    i = ActiveDocument.BuiltInDocumentProperties(14)

    If i >= 1 Then 'Update fields in Header
        For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
         header.Range.Fields.Update
        Next
    End If

    Application.ScreenUpdating = True
End Sub

Недавно я заметил, что он иногда пропускает некоторые части документа. Сегодня пропустилНижний колонтитул первой страницы - раздел 2- потому что версия документа не была обновлена.

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

Для проверки создайте текстовый документ и добавьте настраиваемое поле с именемVersion и дать ему значение. Затем используйте это поле{DOCPROPERTY Version \* MERGEFORMAT } в как можно большем количестве мест. Заголовки, нижние колонтитулы, первая страница, последующая страница и т. Д. И т. Д. Не забудьте создать многосекционный документ с разными верхними и нижними колонтитулами. Затем измените свойство и вызовите макрос. В настоящее время он выполняет довольно хорошую работу, обрабатывая TOC и TOA, TOF и т. Д., Он просто пропускает нижние колонтитулы (иногда) в многосекционном документе, например.

редактировать

Сложный документ, который, кажется, вызывает большинство проблем, имеет следующую структуру:

Имеет 3 раздела.

Раздел 1 предназначен для титульного листа и оглавления, поэтому первая страница этого раздела не имеет верхнего / нижнего колонтитула, но используетVersion собственность на это. Последующие страницы имеют нумерацию страниц римскими цифрами для оглавления.

Раздел 2 предназначен для основной части документа и имеет верхние и нижние колонтитулы.

Раздел 3 предназначен для объявления об авторском праве, и у него очень странный заголовок и урезанный нижний колонтитул.

Все колонтитулы содержатVersion пользовательское свойство документа.

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

Ответы на вопрос(2)

Ваш ответ на вопрос