宏以更新Word文档中的所有字段 [英] Macro to update all fields in a word document

问题描述

多年来，我已经建立了一个vba宏，该宏可以更新Word文档中的所有字段.

I have built - over the years - a vba macro that is supposed to update all fields in a word document.

我在发布文档以供审核之前调用此宏，以确保所有页眉和页脚等正确无误.

I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.

当前-看起来像这样:

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节.

I have noticed recently that it sometimes misses some secions of the document. Today it missed First page footer -section 2- because the document version was not updated.

多年来，我已经建立了这个宏，并进行了数次研究，但我对此并不感到骄傲，因此，如果现在有一个干净的方法，请提出一个完整的替代方案.我正在使用Word 2007.

I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.

要进行测试，请创建一个word文档并添加一个名为Version的自定义字段并为其提供一个值.然后，在尽可能多的地方使用该字段{DOCPROPERTY Version \* MERGEFORMAT }.页眉，页脚，首页，后续页等.记住，制作具有不同页眉/页脚的多节文档.然后更改属性并调用宏.目前，它在处理TOC和TOA TOF等方面做得很好，例如，似乎跳过了多节文档中的页脚(有时).

To test, create a word document and add a custom field named Version and give it a value. Then use that field {DOCPROPERTY Version \* MERGEFORMAT } in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.

似乎引起最多问题的具有挑战性的文档的结构如下:

The challenging document that seems to cause the most problems is structured like this:

它分为3个部分.

第1节用于标题页和目录，因此该节的第一页没有页眉/页脚，但确实使用了Version属性.随后的页面具有TOC的罗马数字页面编号.

Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version property on it. Subsequent pages have page numbering in roman numerals for the TOC.

第2节用于文档正文，并包含页眉和页脚.

Section 2 is for the body of the document and has headers and footers.

第3节用于版权说明，其中包含一个非常奇怪的标题和一个缩小的页脚.

Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.

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

All footers contain the Version custom document property.

我的上面的代码似乎在所有情况下都有效，除了有时会错过第2节和第3节的首页.

My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.

推荐答案

多年来，我用于更新文档中所有字段(TOC等除外，它们是单独处理的)的标准是Word MVP使用和推荐，我将在此处复制.它来自Greg Maxey的网站: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html .我没有在您的版本中看到的一件事是更新页眉/页脚中形状"(文本框)中的任何字段.

For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.

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

这篇关于宏以更新Word文档中的所有字段的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！