宏更新Word文档中的所有领域

Question

我已经建立 - 多年来 - 是应该更新Word文档中的所有字段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

我最近注意到，它有时忽略了文件的某些部分。今天，它错过了第一页的页脚-section 2 - 因为文档版本没有更新。

我已经建立了这个宏在数年的研究几个回合，但我不感到自豪，所以请提出一个完整的更换，如果现在有这样做的一个干净的方式。我使用的是Word 2007。

为了测试，创建一个Word文档，添加一个名为Version自定义字段，并给它一个值。然后用在尽可能多的地方那场{DOCPROPERTY Version \* MERGEFORMAT }可以。页眉，页脚，第一页，后续页面等等，等等记住，以与不同的页眉/页脚的多节文档。然后更改属性和调用宏。目前，它确实相当不错，处理技术选择委员会和技术协议的TOFS等，它只是似乎跳过页脚（有时）例如多段文件内。

编辑

这似乎导致了大多数问题的挑战性文件的结构是这样的：

它有3个部分。

第1节的标题页和TOC，使部分的第一页没有页眉/页脚但使用Version属性就可以了。后续页面有对TOC罗马数字页码。

第2节是文档的主体和具有页眉和页脚。

第3节是版权Blurb的，这有一个很奇怪的头和切下来页脚。

所有页脚包含Version自定义文档属性。

我上面的代码似乎只是有时错过第2和第3的第一页的页脚工作在所有情况下。

Answer 1

多年来，标准我已经用于更新所有字段（TOC例外等，这些另案处理）在文档中是一个话语MVP的使用和推荐，我会在这里复制。它来自格雷格马克西的网站：http://gregmaxey.mvps.org/word_tip_pages/word_fields.html。有一件事它不，我没有在你的版本看到的是更新的页眉/页脚形状的任何字段（文本框）。

Public Sub UpdateAllFields()
  Dim rngStory As Word.Range
  Dim lngJunk As Long
  Dim oShp As Shape
  lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      rngStory.Fields.Update
      Select Case rngStory.StoryType
        Case 6, 7, 8, 9, 10, 11
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                oShp.TextFrame.TextRange.Fields.Update
              End If
            Next
          End If
        Case Else
          'Do Nothing
        End Select
        On Error GoTo 0
        'Get next linked story (if any)
        Set rngStory = rngStory.NextStoryRange
      Loop Until rngStory Is Nothing
    Next
End Sub

Answer 2

一些研究和实验产生了以下除了这似乎解决了我一个多节文档中更新页眉/页脚的主要问题。

    For Each sctn In doc.Sections
        For Each hdr In sctn.Headers
            hdr.Range.Fields.Update
        Next
        For Each ftr In sctn.Footers
            ftr.Range.Fields.Update
        Next
    Next

不过 - 我仍然不是很满意这个代码，并非常希望用更少的东西哈克来取代它。