Public WithEvents appWord As Word.Application

Private Sub appWord_DocumentBeforeSave _
 (ByVal Doc As Document, _
 SaveAsUI As Boolean, _
 Cancel As Boolean)
Call Aktualisieren    
 End Sub

Sub Aktualisieren()

Dim rngDoc As Range
Dim oDoc As Document
Dim docSec As Section
Dim oHF As HeaderFooter
Dim shp As Shape
Set oDoc = ActiveDocument
For Each docSec In oDoc.Sections
  For Each oHF In docSec.Headers
    For Each shp In oHF.Shapes
        With shp.TextFrame
          If .HasText Then
            .TextRange.Fields.Update
          End If
        End With
    Next shp
  Next oHF
  For Each oHF In docSec.Footers
    For Each shp In oHF.Shapes
        With shp.TextFrame
          If .HasText Then
            .TextRange.Fields.Update
          End If
        End With
    Next shp
  Next oHF
  For Each rngDoc In oDoc.StoryRanges
    rngDoc.Fields.Update
    While Not (rngDoc.NextStoryRange Is Nothing)
      Set rngDoc = rngDoc.NextStoryRange
      rngDoc.Fields.Update
    Wend
  Next rngDoc
Next docSec
Set rngDoc = Nothing
Set oDoc = Nothing

End Sub