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