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.
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
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.
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
OP Update:
Thanks for the code KazJaw, it prompted me to change the approach I am trying to tackle the problem with. This is my current code:
Sub Method3()
Dim intFieldCount As Integer
Dim i As Integer
Dim vSt1 As String
intFieldCount = ActiveDocument.Fields.Count
For i = 1 To intFieldCount
ActiveDocument.Fields(i).Select 'selects the first field in the doc
Selection.Expand
vSt1 = Selection.Fields(1).Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
ActiveDocument.Bookmarks(vSt1).Select 'Selects the current crossreference in the ref list
Next i
End Sub
Ok the so the Code currently finds the first field in the document, reads its field code and then jumps to the location in the document to mimic a CTRL+Click.
However, It does this for all types of fields Bookmarks, endnotes, figures, tables etc. I only want to find Reference fields. I thought I could deduce this from the field code but it turns out figures and bookmarks use the same field code layout ie.
A Reference/Boookmark has a field code {REF_REF4123123214\h}
A Figure cross ref has the field code {REF_REF407133655\h}
Is there an effective way to get VBA to distinguish between the two? I was thinking as reference fields in the document are written as (Reference 1) I could find the field and then string compare the word on the left to see if it says "Reference".
I was thinking of using the MoveLeft Method to do this
Selection.MoveLeft
But I can't work out how to move left 1 word from the current selection and select that word instead to do the strcomp
Or perhaps I can check the field type? with...
If Selection.Type = wdFieldRef Then
Do Something
End If
But I am not sure which "Type" i should be looking for.
Any advice is appreciated
All REF fields "reference" bookmarks. Word sets bookmarks on all objects that get a reference for a REF field: figures, headings, etc. There's no way to distinguish from the content of the field what's at the other end. You need to "inspect" that target, which you can do without actually selecting it. For example, you could check whether the first six letters are "Figure".
The code you have is inefficient - there's no need to use the Selection object to get the field code. The following is more efficient:
Sub Method3()
Dim fld As Word.Field
Dim rng as Word.Range
Dim vSt1 As String
ForEach fld in ActiveDocument.Fields
vSt1 = fld.Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
Set rng = ActiveDocument.Bookmarks(vSt1).Range
If Left(rng.Text, 6) <> "Figure" Then
rng.Select
End If
Next
End Sub
Frequently, I have to change all headings of a word-document depending on a the content of a customproperty. For example, if the document prorperty 'Status' equeals to anything but final, all headings must contain 'DRAFT' written in bold characters on a red-background. If the document is 'final', DRAFT must not appear and the background must be 'none'.
Except for the first section, our headings contain a table consisting of one row and two cells. Cell 1 must be flipped depending on the 'Status', Cell 2 must remain unchanged.
Is there any known solution (VBA or cell-specific 'IF-THEN-ELSE Statements) to change the content of cell 1 throughout the whole document depending on the Status document property? Currently, I do have to scroll through all sections and change the header manually.
You can do this using a field and a macro. The field will create the values, and the macro will update them to account for changes.
Let's say that you're using the document property status as you've described. If the value is "DRAFT" the text in the table will be "This is a draft" and if it is anything else the text will be "This is not a draft". Word can be squirrely about these properties, so the first thing I would do is a test. Set your property to DRAFT and then create a field to ensure that Word is reading it.
Anywhere in your document type:
[Ctrl+F9] DOCPROPERTY Status
This will result in text that looks like
{DOCPROPERTY Status}
but be aware that you have to use Ctrl+F9 to get the special field brackets.
Now toggle the field code (select, right-click and choose Toggle Field Codes). If it becomes text that says DRAFT you are ready to go. If not, you may not be setting the property the way that Word wants you to. The way I do this is by going to Advanced Properties, clicking the Custom tab, finding Status in the list, adding the value, and clicking Add so that it appears below. There may be other ways, but that works.
Once you've had success with that field code, create a new one in your table that looks like this (remember that all brackets are created with Ctrl+F9):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1 "This is a draft" "This is not a draft" }
The If statement compares the value of the compare statement to 1, and the two quoted strings after reflect what will appear if the If statement evaluates to true, and what will appear if it evaluates to false. Toggle the field codes to see what you get.
Then, you can create a little macro that will update them all for you, so you don't have to manually update each one. Something like this should work:
Public Sub UpdateAllFields()
Dim objDoc as Document
Dim objSect As Section
Dim objHeader As HeaderFooter, objFooter As HeaderFooter
Set objDoc = ActiveDocument
objDoc.Fields.Update
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
objHeader.Range.Fields.Update
Next objHeader
For Each objFooter In objSect.Footers
objFooter.Range.Fields.Update
Next objFooter
Next objSect
End Sub
I misread and didn't realize the color change applied to these tables, so adding something about that.
The font color can be changed using the field. Change the field above so that it looks like this (remember about Ctrl+F9) (I'm adding some line breaks for readability. Do not include these in your field. Put it all on one line):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1
{ QUOTE "This is a draft" \*Charformat }
{ QUOTE "This is not a draft" \*Charformat } }
Then select each of the quote fields in turn and apply whatever font formatting you need. You can also apply highlighting in this way; I don't think this will be sufficient for your requirement to shade the whole cell but you might try it out and see if you can avoid additional steps.
If you definitely need to shade the whole cell, than you'll need another macro. Something like this should do it:
Sub ChangeCol()
Dim objDoc As Document
Dim objTable As Table, objCell As Cell
Dim objFld As Field
Set objDoc = ActiveDocument
For Each objFld In objDoc.Fields
If objFld.result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
If objDoc.CustomDocumentProperties("Status").Value = "DRAFT" Then
objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else: objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
End If
Next objFld
End Sub
Just run that along with the UpdateFields macro to keep them in sync (or write a third macro that triggers both of them so you don't forget).
Please accept my acknowledges once more. Hereafter, the macros I make use of for my purpose:
Private Sub colorizeTableCells(ByVal oFields As fields, sStatus As String)
Dim objFld As field
Dim bgColor As WdColor
oFields.Update
For Each objFld In oFields
If objFld.Result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
bgColor = wdColorAutomatic
If sStatus = "DRAFT" Then
bgColor = wdColorRed
End If
objFld.Result.Cells(1).Shading.BackgroundPatternColor = bgColor
End If
Next objFld
End Sub
Sub processHeaderAndFooterFields()
Dim objDoc As Document
Dim objSect As Section
Dim objHeader As HeaderFooter
Dim objFooter As HeaderFooter
Dim sStatus As String
Set objDoc = ActiveDocument
sStatus = objDoc.CustomDocumentProperties("Status").Value
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
colorizeTableCells oFields:=objHeader.range.fields, sStatus:=sStatus
Next objHeader
For Each objFooter In objSect.Footers
colorizeTableCells oFields:=objFooter.range.fields, sStatus:=sStatus
Next objFooter
Next objSect
End Sub