Macro to update all fields in a word document

前端 未结 2 528
忘了有多久
忘了有多久 2020-12-19 08:31

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 t

相关标签:
2条回答
  • 2020-12-19 08:45

    Some research and experimentation produced the following addition which seems to solve the additional problem of updating the headers/footers in a multi-section document.

    Add the following dimensions to the earlier answer:

    dim sctn as Word.Section
    dim hdft as Word.HeaderFooter
    

    And then, add to the earlier code

    for each sctn in doc.Sections
      for each hdft in sctn.Headers
         hdft.Range.Fields.Update
       next
       for each hdft in sctn.Footers
         hdft.Range.Fields.Update
       next
    next
    

    However - I am still not happy with this code and would very much like to replace it with something less hacky.

    0 讨论(0)
  • 2020-12-19 09:08

    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
    
    0 讨论(0)
提交回复
热议问题