View Single Post
 
Old 01-21-2012, 11:33 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Jamal,

Yes, that is possible, but requires a fair bit of code to implement. For the open/close side of things, add the following code to your 'Normal' template's 'ThisDocument' module:
Code:
Sub RefreshFields(Doc As Document)
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 pRange As Range ' Word Range Object
With Doc
  ' Loop through Story Ranges and update.
  ' Note that this may trigger interactive fields (eg ASK and FILLIN).
  For Each pRange In .StoryRanges
    Do
      pRange.Fields.Update
      Set pRange = pRange.NextStoryRange
    Loop Until pRange Is Nothing
  Next
' The following routines are necessary because the foregoing updates only page numbers
' in TOCs, TOAs and TOFs - field updating doesn't update TOC, TOA or TOF contents.
  ' Loop through Tables Of Contents and update
  For Each TOC In .TablesOfContents
    TOC.Update
  Next
  ' Loop through Tables Of Authorities and update
  For Each TOA In .TablesOfAuthorities
    TOA.Update
  Next
  ' Loop through Tables Of Figures and update
  For Each TOF In .TablesOfFigures
    TOF.Update
  Next
End With
Call AcceptTrackedFields(Doc)
End Sub
 
Sub AcceptTrackedFields(Doc As Document)
'This sub accepts any tracked changes affecting fields
Dim oRng As Range, oFld As Field
With Doc
  ' Loop through all range objects and accept tracked changes on fields
  For Each oRng In .StoryRanges
    Do
      For Each oFld In oRng.Fields
        oFld.Select
        Selection.Range.Revisions.AcceptAll
      Next
      Set oRng = oRng.NextStoryRange
    Loop Until oRng Is Nothing
  Next
End With
End Sub
 
Private Sub Document_Close()
Dim bSaved As Boolean
bSaved = ActiveDocument.Saved
Call RefreshFields(ActiveDocument)
If bSaved = True And ActiveDocument.Saved = False Then ActiveDocument.Save
End Sub
 
Private Sub Document_Open()
Call RefreshFields(ActiveDocument)
End Sub
To intercept printing & saving requires creating events to intercept. Using Events requires that you instantiate the app object class. To do this, create a new class module in the Normal template to register your events. At the top of the module put:
Code:
Public WithEvents wdApp As Word.Application
Public WithEvents wdDoc As Word.Document
Then, in a normal code module in the template, put:
Code:
Dim wdAppClass As New ThisApplication
Public Sub AutoExec()
Set wdAppClass.wdApp = Word.Application
End Sub
This will allow you to get events from your Word document. Now you can add the following code to your Normal template's 'This Document' module:
Code:
Private Sub wdApp_DocumentBeforePrint(ByVal Doc As Document, Cancel As Boolean)
Call RefreshFields(ActiveDocument)
End Sub
 
Private Sub wdApp_DocumentBeforeSave(ByVal Doc As Document, Cancel As Boolean)
Call RefreshFields(ActiveDocument)
End Sub
Note that I haven't tested this code (though it should work) and don't know what the outcome might be with all the different kinds of documents one might work with. In some cases (eg documents with ASK & FILLIN fields), the results may well be undesirable.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote