使用VBA在MS Word中创建动态列表号

Question

I wonder how can I insert dynamic multilevel list numbers.
The client request applying his Word 2010 template a "Point Headings" - similar to Point Pages behavior.

Meaning:
Assuming the following Heading formats:
Heading 2 - 1.1
Heading 3 - 1.1.1
Heading 4 - 1.1.1.1
Heading 5 - 1.1.1.1.1

The purpose is to keep existent numbering and add in between numbered list.
For example:
Between two Heading 3 style headers 1.3.5 and 1.3.6 will come 1.3.5.A followed by 1.3.5.B and so on. obviously a requirement is that 1.3.6 won't be changed.

What I wish to get & the easiest way to get there (in my opinion):
I want 4 macro subroutines (one for each heading style) which will insert in the current caret position (can be assumed that Selection is the caret location alone) the selected "point heading".

My thinking was to execute the following flow:
(Line format: Action - Example)

• Apply selected style (let's say Heading 3) - result: 1.2.3
• Find previous value (can be assumed that it isn't the first one) - result: 1.2.2
• Copy the string content (using ListFormat.ListString ) - result: value 1.2.2 is copied
• Apply a new style to this specific location with alphabetical number format and the prefix I have. - result: The list number will be 1.2.2.A

What I've tried so far:

• First sanity check was to manually insert a new list style in the multiLevel list menu. The problem is that this style cannot be used more than once (or at least that's what I've seen). If I wish to change the number prefix, it applies to all of its siblings with the same style.

• Then I've tried a code snippet taken from HERE with some adjustments

   Sub applyPointHeadingTest() With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2) .NumberFormat = "1.1.%2" .TrailingCharacter = wdTrailingSpace .NumberStyle = wdListNumberStyleUppercaseLetter .NumberPosition = CentimetersToPoints(0) .Alignment = wdListLevelAlignLeft .TextPosition = CentimetersToPoints(5.31) .TabPosition = CentimetersToPoints(5.95) .StartAt = 1 .LinkedStyle = "Point Heading Style 2" End With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).name = "ComplexNo2" Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _ ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _ ContinuePreviousList:=True, ApplyTo:=wdListApplyToSelection, _ DefaultListBehavior:=wdWord10ListBehavior End Sub 

  While this work for the first time I run the method, on next executions it changes every list in the document.

• That's it basically. I'm out of ideas..

Can anyone guide me how to do that?

Thanks.

Answer 1

Field codes can be used for "intermittent" numbering that's related to the Heading numbering, but doesn't fit for some reason in the ListTemplate assigned to the Heading levels. This numbering is dynamic, in that it updates according to referenced numbering preceding it. It cannot, however, update automatically - the field results must be updated either manually (F9, most often Ctrl+A, F9 for the entire document) or using a macro ( Fields.Update ). You can also set the document's Print options to automatically update fields.

For the situation you outline, this pair of fields should work:

{ StyleRef 3 \n }{ SEQ "between" \* ALPHABETIC \s 3 }

• StyleRef reflects the first preceding instance of the specified style. In this case, that's "Heading 3" - you can use 1 - 9 to specify a built-in Heading style which makes the field local language independent.
• The \\n displays only the numbering, no text.
• SEQ inserts sequential numbering - you give it a label for the numbering belonging to that sequence throughout the document.
• \\* ALPHABETIC puts the result in capitalized letters.
• \\s lets you say from what Heading level onwards it should restart numbering.

If you want to use code to insert these fields, then something along these lines:

Dim rng As word.Range
Dim fld As word.Field
Dim sQuote As String

sQuote = Chr(34)
Set rng = Selection.Range
Set fld = rng.Fields.Add(rng, wdFieldEmpty, "StyleRef 3 \n", False)
Set rng = fld.result
'Move focus after the inserted field
rng.Collapse wdCollapseEnd
rng.MoveStart wdCharacter, 1
rng.InsertAfter "."
rng.Collapse wdCollapseEnd
rng.Fields.Add rng, wdFieldEmpty, "SEQ " & sQuote & "between" & _
                    sQuote & " \* ALPHABETIC \s 3", False
rng.Parent.Fields.Update 'update fields in the document body