Macro to update all fields in a word document - vba

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.
Currently - it look like this:
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
I have noticed recently that it sometimes misses some sections of the document. Today it missed First page footer -section 2- (the document version was not updated).
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.
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.
Edit
The challenging document that seems to cause the most problems is structured like this:
It has 3 sections.
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.
Section 2 is for the body of the document and has headers and footers.
Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.
All footers contain the Version custom document property.
My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.

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

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.

Thanks for these answers! I found the answers very good and learned some stuff about ms-word macros. I thought I'd make my own answer for consideration (and adding some more search engine keywords - my searches didn't bring me here immediately).
I took inspiration from the citations in the footnotes.
I had an issue where MS Word fields were not updating in Textbox (Shapes).
I was working on a 70 page word document (Word 2013) that contained a lot of figures/images/captions and cross-references. A common practice is for an image to be captioned e.g. Figure 7, so it can be easily cross-referenced. Often the caption is inside a textbox (shape) and grouped with/to the object its captioning.
So after some document editing and content reorganisation, the fields and cross-references can easily get out of logical sequence.
OK - no problem... pressing CTRL+A then F9 to update the document fields should solve this?
Unfortunately that didn't work as expected to update fields in textboxes (shapes).
In this scenario where fields exist inside textboxes (shapes) CTRL+A then F9 only updated the fields not inside a textbox (shape).
One can assume this behaviour is because field updating (F9) works on selected text, and with the CTRL+A then F9 approach only text outside of the textboxes (shapes) is selected, so the field update only applies outside of textboxes (shapes).
I'm surprised there is not a button on the ribbon to perform an "update all fields". There could even be a toggle option to prompt the user to update all fields when closing a document?
I checked Word's (2013) ribbon command list, and didn't find an Update All command.
Solution UpdateAllFields()
Like the code shared by #Cindy here, the following code should update fields wherever they are in the doc, header, footer, main doc, textbox, grouped and nested grouped textbox.
Create a macro with the following code, and then add to the Quick Access Toolbar (QAT)
Press ALT+F8 to open the Macros dialogue.
Enter a name for the Macro: UpdateAllFields
Press Create button
Paste the code:
Sub UpdateAllFields()
Application.ScreenUpdating = False
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Finally add the Macro to the Quick Access Toolbar.
Citations and inspirations:
The Q&A's in this post!
There is a related post on the Microsoft Community here: Word 365 Fields not updating in Textbox [serious reproducible error]. This suggests the issue is present in at least Word 2013 and Word 365.
There is a related post on Stack Overflow here: Macro to update fields in shapes (textboxes) in footer in Microsoft Word.
Another example UpdateTextboxFields()
This was the first version of code I wrote as I was in research and solution mode. Its a recursive approach to update fields inside textboxes, even if they are inside a group, or nested group. This doesn't update fields outside shapes.
Public Sub UpdateTextboxFields()
Application.ScreenUpdating = False
With ActiveDocument
Call IterateShapesCollection(.Shapes)
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Private Sub IterateShapesCollection(col)
Dim shp As Shape
For Each shp In col
' https://learn.microsoft.com/en-gb/office/vba/api/office.msoshapetype
' Ignore images and
If 1 = shp.Type Or 13 = shp.Type Then
GoTo NextIteration
End If
'Debug.Print ("Name: " & shp.Name & ", Type: " & shp.Type)
' if the type is a group, recurse
If 6 = shp.Type Then
Call IterateShapesCollection(shp.GroupItems)
Else
Call UpdateShapeFields(shp)
End If
NextIteration:
Next
End Sub
Private Sub UpdateShapeFields(shp)
With shp.TextFrame
If .HasText Then
.TextRange.Fields.Update
End If
End With
End Sub
Word display option: Update fields before printing
cite: Microsoft article Some fields are updated while other fields are not
The concept behind this option/approach is: all document fields are updated when you open print preview.
It looks like this option in Word (tested in 2013) updates all fields with a caveat - see below - you may need to open and close print preview twice.
File → Options → Display → Print options section → Update fields before printing
Caveat if the doc has cross-references to figures/captions
This caveat applies to the word "Update fields before printing" display option and the UpdateAllFields() macro.
IF the document contains cross-references to figures/captions (with numbers), and those figures/captions have changed sequence/place in the document...
You must update the fields twice, 1) to reflect the figures/captions update, and then 2) to update the cross-references.

Related

Edit a the text in a Shape(textbox) that is placed somewhere on a Word Doc VBA

I'm trying to create a way for a word document to have certain textfields data to be replaced with other data. In my case, textfields are shown as a part of shapes and the textfields themselves don't have name's to them so I wanted to possibly do it by their shape ID. So for example I have a 5 Textboxes next to each other and say I want to edit the 4th textbox to say something since it's blank without affecting the other textboxes. What would I need to do?
Though Process: Because all the files have the same format, if I can figure out the id of that shape or textbox, I can directly reference that id and change the textfield that way. The text in the field is all random so I can't do a specific find word and replace so that's why I'm trying to do it by id or even just by having it do a count of the number of shapes on the page of a word document.
Tip: I turned on paragraph markers to see the textboxes more clearly.
Example of Code I've written so far:
Sub TextBox()
'find a specific textbox and edit it
Dim doc As word.Document, rng As word.Range
Dim shp As Shape, iShp As word.InlineShape
Set doc = ActiveDocument
Dim textbCount As String
Dim textbId As String
'textbCount = ActiveDocument.Shapes.Count
'textbId = oShape.ID
Dim sr As ShapeRange
Set sr = shp.TextFrame.TextRange.ShapeRange(5)
For Each shp In sr
If shp.ID = 0 Then
'oShape.TextFrame.TextRange.InsertAfter shp.ID
'shp.Delete
Debug.Print shp.Type
Debug.Print shp.ID
End If
Next shp
If ActiveDocument.Shapes.Count > 0 Then
For Each shp In ActiveDocument.Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If shp.TextFrame.HasText = True Then
'shp.TextFrame.TextRange.GoToNext (wdGoToField)
'shp.Delete
'shp.Delete
shp.TextFrame.TextRange.InsertAfter textbCount
Exit For
End If
End If
Next shp
End If
End Sub
This is code you could use, I was able to just figure out the answer. What the code does is checks that the word document that you are trying to read is open and then it first checks to see if there are any shapes at all on the document which is the c > 0 because textboxes are categorized as shapes. Then it does a For Each loop going through all the shapes on the entire document and each shape has it's own unique identifier.
I already tested this for if templates that have the same format of textboxes, they will typically share the same identifier, so if you say have 2 word documents with each 20 textboxes and its a carbon copy of the other just with different text in the boxes almost like they took this blank document and then used it as the base template, it's highly likely that the ID's between the 2 documents are the same if opened separately, if they are combined into 1 document is when the ID's will change so that your not referencing the same data.
To continue on with the code, it will next check all the textboxes for a #, this can be changed out for anything, but for my case I wanted to find out which boxes by their ID I would be using since the word doc won't tell you, so because no where else on the document had #'s, I used those to find where the boxes were. Once you know the ID, you can just reference the boxes directly instead of using the #'s but you need to first know which ones have them.
Next the code will print to the "Immediate Window" which is like a debug window that you can open either in the view tab or by ctrl + G if your one windows and what it will print is the shape ID for each shape that has the # and then print whatever text is in that box which should include the # there along with whatever text is there in that box.
Now if you want to add text to the text box, I didn't include it in my example, or even replace the text. Just make an if statement for if shp.ID = 16 for example then inside that If Then statement say shp.TextFrame.TextRange.Text = "" or if you have a string you want to pass in, replace "" with whatever string that is and in the double quotes you can either leave that blank to make that textbox your referencing blank or you can put text in it to make it say something.
If your doing a project, like I was, and it requires checking a lot of these textboxes to reference the string to another textbox so basically one textbox determines the other. Use For Each shp In oShp a lot or your equivalent to that and check each ID and store it in a string variable and then do a separate For Each to reference those string variables to make new if statements or declarations since you you'll need to go through all the textboxes at least once to grab whatever data might be contained in them since it goes through the For Each sequence one at a time.
Dim shp As Shape
Dim oShp As Object
Dim doc As Document
Dim c As Integer
Dim objWord As Object
Dim objDoc As Document
'Set doc = ActiveDocument
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\word.docx") 'Set this to wherever the word file is located along with the name of the word file so "C:\Users\worddoc.docx" is an example you could do
'Set objDoc = objWord.ActiveDocument
Set doc = objWord.ActiveDocument
Set oShp = doc.Shapes
c = ActiveDocument.Shapes.Count
'Set text1 = shp.TextFrame.TextRange
If c > 0 Then
For Each shp In oShp
If InStr(shp.TextFrame.TextRange.Text, "#") Then
Debug.Print shp.ID
Debug.Print shp.TextFrame.TextRange.Text
End If
Next shp
Debug.Print c
End If

Visio VBA: How to make all text in Org Chart Bold

I would like to simplify updating my orgcharts in Visio. So far I have a macro borrowed from here https://bvisual.net/2010/01/28/applying-selected-datagraphic-to-the-whole-document/ and written out below. I would like to adapt it to make some changes to the format of the text withing shapes e.g. to make the font bold and potentially to change it's colour. I'm finding it really difficult to find examples of this online so any help/suggestion would be greatly appreciated.
Public Sub ApplyDataGraphicToDocument()
Dim mstDG As Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.Page
Dim firstProp As String
If Visio.ActiveWindow.Selection.Count = 0 Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
Set shp = Visio.ActiveWindow.Selection.PrimaryItem
If shp.DataGraphic Is Nothing Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
'Get the shapes DataGraphic master
Set mstDG = shp.DataGraphic
'Get the name of the first Shape Data row
firstProp = "Prop." & _
shp.CellsSRC(Visio.visSectionProp, 0, 0).RowNameU
End If
End If
For Each pag In Visio.ActiveDocument.Pages
If pag.Type = visTypeForeground Then
For Each shp In pag.Shapes
'Check that the named Shape Data row exists
If shp.CellExistsU(firstProp, Visio.visExistsAnywhere) Then
'Set the DataGraphic
shp.DataGraphic = mstDG
End If
Next
End If
Next
End Sub
You can modify the default OrgChart shapes, although it is not officially supported. To change the default shapes (make their font bold), you'll need to edit the templates (masters) for those OrgChart shapes. In the same blog you can find more information on customizing the OrgChart diagrams, here: https://bvisual.net/2012/05/08/creating-a-custom-org-chart-template-with-extra-properties
The procedure is mostly the same, just instead of adding the properties, you make the text bold.

How can i change every occurence of a specific font ind a Word document?

i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub

Select Range of DocProperty

I have endless Word-Documents, all with the same DocProperty somewhere in it.
Now I have to modify the font style of this specific DocProperty (e.g. make it bold), any other DocProperty has to been skipped.
How do I select this DocProperty with VBA?
I looked into the ActiveDocument.Range.Fields collection, but where is the name of the linked DocProperty? I'm only finding the Text, but that is the value of the actual CustomDocProperty
You were on the right track. In short you want: -
To look in Field.Type for a value of 85 (WdFieldDocProperty)
Then check the Field.Code for the property name/label
A sample of checking a document for it is below with comments to explain what is happening: -
Public Sub Sample()
Dim WdDoc As Word.Document
Dim Fld As Word.Field
'Connect to the Document
Set WdDoc = ThisDocument
'Only work if there are fields in the document to begin with
If WdDoc.Fields.Count > 0 Then
'Check each field
For Each Fld In WdDoc.Fields
'If the type is a DocProperty then we may have a match
If Fld.Type = wdFieldDocProperty Then
'If the code contains the name we are after then we have a match!
If InStr(1, Fld.Code, "Custom1") Then
'Select the field
Fld.Select
'Format the selection
Selection.Font.Bold = True
End If
End If
Next
End If
Set WdDoc = Nothing
End Sub
As a further tip (if you haven't done it all ready) would be to use the FileScriptingObject to help process all of your documents in one go using a loop. If you do try that and get stuck, start a new question with how far you got and what is not working and SO will help out I'm sure.

Update all fields in a Word document when user types anything

I want a way of updating all the fields on a document automatically. I currently have a macro which is linked to F9. This macro updates all the fields in the header and footer, as well as all the ones in the main document.
Sub UpdateFields()
Dim oStory As Range
For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory
Set oStory = Nothing
End Sub
Apart from setting the macro on every key, how would I make it so this macro runs when the user types anything?
For example a user may place a field in the footer or header which shows the amount of characters. If this was the case I would like to be able to see the characters field update as I type.
Here are the events in Word VBA :
For the application :
https://msdn.microsoft.com/EN-US/library/office/dn320473.aspx
For the document :
https://msdn.microsoft.com/EN-US/library/office/dn320613.aspx
I would suggest that you use the Application.WindowSelectionChange event (Occurs when the selection changes in the active document window) : https://msdn.microsoft.com/EN-US/library/office/ff192791.aspx
Public WithEvents appWord As Word.Application
Private Sub appWord_WindowSelectionChange(ByVal Sel As Selection)
UpdateFields
End Sub
And if you need more details on that, you'll find some here : https://msdn.microsoft.com/library/office/ff746018.aspx