VBA Example
VBA Example
This page presents some detail of building up VBA code to correctly update an Index Field when Headers and Footers are different before and after it. Details of the basic problem and a UI solution are presented in the main article and on other pages linked from it. This is not a VBA course, and it is assumed that, if you read further, you understand VBA.
The VBA code needed for this, I’m afraid, has its own set of complications. The first one is identifying the field(s) to be updated. As you have seen in the examples (if you have taken detours to read them), updating a field through the User Interface requires only that the cursor (the insertion point) be somewhere within the field.
If you place the cursor in a field, but do not Select the whole field, and then type ?Selection.Fields.Count in the Immediate Window, and press Enter, you will get the answer 0. Before trying anything else, you need to find a way to identify the fields ‘under’ the cursor, those that are acted upon by user instructions. The VBA ‘rules’ are as follows:
As Fields of interest may not be shown as being in the Range of interest, it is necessary, before doing anything else, to work out what they may be. What follows is, I’m sure, but one of many ways to do this.
Here's a basic Function that calculates, as per the above rules, and returns, the number of Fields effectively in the Selection, that is the number of Fields that would be updated if you pressed F9. Explanation, beyond the above, is beyond the scope of this article.
Function NumberOfFields(RangeI As Word.Range) As Long
Dim FieldsB As Long
Dim FieldsA As Long
Dim FieldsT As Long ' Total
Dim Story As Word.Range Set Story = ActiveDocument.StoryRanges(RangeI.StoryType) With ActiveDocument.StoryRanges(RangeI.StoryType) FieldsT = .Fields.Count .SetRange Story.Start, RangeI.Start - (Len(RangeI.Text) = 0) FieldsB = .Fields.Count .SetRange RangeI.End, Story.End FieldsA = .Fields.Count End With NumberOfFields = Abs(FieldsA + FieldsB - FieldsT) End Function
Experiment with a trivial driver (or type ?NumberOfFields(Selection.Range) in the Immediate Window) to see that you always get the right result (and tell metell me [link to e-mail the author at mailto:Tony@WordArticles.com] if you don’t!)
Lest it has escaped your notice, all that this code gives you is a count of the number of fields you have to look at; it doesn't even tell you which ones they are. To find that out you must, somehow expand the selection, or a range based on it.
Assuming the range is somewhere inside a field (if it isn’t you have no more to do), you now need to expand the range to include the outermost field. You have seen that when a Field End character is in a range, the field is in the range’s Fields Collection, so extending the range forward until it includes the Field End character of the outermost field will ensure you have the collection you need.
Extending your range to the next Field End character will include another field in it, but it will also include any nested fields wholly within that field, but not necessarily within the range. Extending the range, one Field End character at a time and checking each time to see whether you have managed to amass the correct number of fields in the collection, as determined above, will allow you to determine when you have reached the outermost Field End character.
One point of interest is that the special case mentioned above isn't really special any more, here. Extending the Range to a Field End character immediately includes the outermost Field Start character, which has the same effect as the Field End character for your purposes here, so a single iteration of the loop will produce the Fields Collection you want.
The only other thing to be aware of, is that the Field End character (0x15) can only be seen in the range if Field Codes are 'visible'. The VBA for all this, after calling the above Function to determine the number of fields, is little more than a simple loop:
Sub ProcessFields() Dim NumFields As Long NumFields = NumberOfFields(Selection.Range)
With Selection.Range .TextRetrievalMode.IncludeFieldCodes = True While .Fields.Count < NumFields .MoveEndUntil Chr(&H15) .MoveEnd wdCharacter, 1 Wend End With End Sub
You're halfway there now; you have a Collection of Fields! All these Fields are going to be updated and you may want to control the updating of some of them.
It must be said, before going further, that there are many theoretical possibilities that the following code does not consider, for example the possibility of separate Headers having been applied to an Index itself, rather than just the section after it, or, slightly more obscurely perhaps, a REF field referring to an INDEX elsewhere. Please feel free to tackle this kind of thing on your own! All that the code here does is to check if any INDEX fields are directly in scope and, if so, ensure that the details of the section before it are not lost.
Before doing the Fields Update you want to save the Section Break at the start of each Index Field’s result. As I mentioned somewhere, by saving these as AutoTexts you are not restricted in how many you can cope with; you just need ensure they all have different names – and, preferably, names that differ from any the user may have used. To this end, in the following code, I use a counter and the non-keyboard character, ASCII code 28; I somewhat arbitrarily chose 28 because it is a perfect number. A piece of housekeeping (good behaviour, if you like) before continuing is to decide which template to use to store the AutoTexts, and to remember the Saved state of this Template so that you can reset it afterwards. I have chosen, again a little arbitrarily, to use the Document's Template.
All that is needed is a little loop to run through the Fields, select the Index ones and save the first character (the first Section Break – assuming it has one) of the Result of each as an AutoText. It is possible that a field (even an Index field) does not have a Result but, in this case it won’t have multiple sections and section breaks will not be looked for. There is another small piece of housekeeping to include inside the loop; there is a possibility that an AutoText has been left lying around from an earlier run (it does happen!) so, to be safe, any old (relevant) AutoText that might exist, is deleted.
Here’s the code so far, an amended version of the above:
Sub ProcessFields() Dim NumFields As Long Dim TemplateSaved As Boolean Dim AutoTextPrefix As String Dim AutoTextCount As Long Dim AutoTextName As String Dim AutoTexts As AutoTextEntries
Dim OneField As Word.Field NumFields = NumberOfFields(Selection.Range) With Selection.Range .TextRetrievalMode.IncludeFieldCodes = True While .Fields.Count < NumFields .MoveEndUntil Chr(&H15) .MoveEnd wdCharacter, 1 Wend TemplateSaved = .Document.AttachedTemplate.Saved Set AutoTexts = .Document.AttachedTemplate.AutoTextEntries AutoTextPrefix = Chr$(28) & "Section" & Chr$(28) & "Break" & Chr$(28) AutoTextCount = 0 For Each OneField In .Fields If OneField.Type = wdFieldIndex Then AutoTextCount = AutoTextCount + 1 AutoTextName = AutoTextPrefix & CStr(AutoTextCount) On Error Resume Next AutoTexts(AutoTextName).Delete On Error GoTo 0 With OneField.Result If .Sections.Count > 1 Then ' Nothing else to do if no breaks .Collapse wdCollapseStart .MoveEnd wdCharacter, 1 AutoTexts.Add AutoTextName, Range:=.Duplicate End If End With End If Next OneField .Fields.Update ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Code to replace the Section Breaks will go here! ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' End With End Sub
Now to fill in the missing detail. Just as before the update, you need to loop through the fields, finding the Index ones. It is possible that after the update, there are not the same number of Index fields, or there are, but they are actually different ones. There is no guaranteed way to identify this kind of anomaly (barring a comprehensive analysis of the fields) but the likelihood of it happening is small enough to be ignored, at least for the moment. The discussion and code that follows assumes a one-to-one correspondence between Index fields before the update and Index fields after the update.
Also as before the update, Index fields may or may not contain generated section breaks. There are four cases to consider:
So, after doing the fields pdate, another small loop, more or less the reverse of the earlier one, runs through the same fields, replacing the original section breaks — or not, as described above. The check for multiple sections means nothing is done if there aren’t (now) any breaks, and the error trap catches the cases where there is no saved section break.
Here's the code now, a further amended version of the above:
Sub ProcessFields() Dim NumFields As Long Dim TemplateSaved As Boolean Dim AutoTextPrefix As String Dim AutoTextCount As Long Dim AutoTextName As String Dim AutoTexts As AutoTextEntries
Dim OneField As Word.Field NumFields = NumberOfFields(Selection.Range) With Selection.Range .TextRetrievalMode.IncludeFieldCodes = True While .Fields.Count < NumFields .MoveEndUntil Chr(&H15) .MoveEnd wdCharacter, 1 Wend TemplateSaved = .Document.AttachedTemplate.Saved Set AutoTexts = .Document.AttachedTemplate.AutoTextEntries AutoTextPrefix = Chr$(28) & "Section" & Chr$(28) & "Break" & Chr$(28) AutoTextCount = 0 For Each OneField In .Fields If OneField.Type = wdFieldIndex Then AutoTextCount = AutoTextCount + 1 AutoTextName = AutoTextPrefix & CStr(AutoTextCount) On Error Resume Next AutoTexts(AutoTextName).Delete On Error GoTo 0 With OneField.Result If .Sections.Count > 1 Then ' Nothing to do if no breaks .Collapse wdCollapseStart .MoveEnd wdCharacter, 1 AutoTexts.Add AutoTextName, Range:=.Duplicate End If End With End If Next OneField .Fields.Update AutoTextCount = 0 For Each OneField In .Fields If OneField.Type = wdFieldIndex Then AutoTextCount = AutoTextCount + 1 AutoTextName = AutoTextPrefix & CStr(AutoTextCount) With OneField.Result If .Sections.Count > 1 Then ' Do nothing if no Break .Collapse wdCollapseStart .MoveEnd wdCharacter, 1 On Error Resume Next ' Will fail (code 5941) if no saved Break AutoTexts(AutoTextName).Insert .Duplicate, True On Error GoTo 0 End If End With On Error Resume Next AutoTexts(AutoTextName).Delete On Error GoTo 0 End If Next OneField .Document.AttachedTemplate.Saved = TemplateSaved End With End Sub
You may remember that I used Building Blocks, instead of AutoTexts, when working through an example in the UI, but I have used AutoTexts in the code here. This code will work with all versions of Word. If you are using Word 2007 you can replace the AutoText code with Building Block code very simply.
Clearly, in real life code you would use different variable names and, maybe, make some other changes, but, for demonstration purposes only, just change the definition of the variable “AutoTexts”, from:
Dim AutoTexts As AutoTextEntries
to:
Dim AutoTexts As BuildingBlockEntries
.. and then change the assigning of a value to it, from:
Set AutoTexts = .Document.AttachedTemplate.AutoTextEntries
to:
Set AutoTexts = .Document.AttachedTemplate.BuildingBlockEntries
.. and, finally, when creating the Building Block, to make it as demonstrated earlier, add the Building Block Type and Category to the Add statement. If you don't do this, Word will use its default values, which, given that you're going to delete the thing afterwards, probably doesn't matter.
AutoTexts.Add AutoTextName, Range:=.Duplicate
to:
AutoTexts.Add AutoTextName, Range:=.Duplicate, _
Type:=wdTypeQuickParts, Category:="Temporary"
It is quite likely I will return and update this page to make the code deal with more situations, but that’s it for now. You can return to the main piece.You can return to the main piece. [link to the Code example at IndexUpdate.php#CodeExampleLink].