Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

How to cure Word's List Numbering with a dose of VBA

57 views
Skip to first unread message

Martin Fabian

unread,
Sep 18, 2001, 4:38:28 AM9/18/01
to
Struggling with understanding Words list numbering I read John McGhie's
excellent "Word's numbering explained" article on
http://www.mvps.org/word. Thanks John, that explained a lot of the stuff
I've been struggling with. This article contains a ref to "How to cure
Word's List Numbering with a dose of VBA" written by Dave Rado. I
thought this might help me solve some problems. However, that article is
said to be "added here very soon". Does anyone know when? Is there a
draft out there somewhere? I'd really like to hear about how to cure
Words list numbering mess.

--
Martin Fabian http://www.s2.chalmers.se/~fabian/
--
Ask enough experts. Eventually you'll get the answer you want.

/* Remove NOSPAM from reply-to address to mail me */

Suzanne S. Barnhill

unread,
Sep 18, 2001, 9:30:01 AM9/18/01
to
It's been "coming soon" for as long as I can remember. <g>

--
Suzanne S. Barnhill
Microsoft Word MVP
Words into Type
Fairhope, AL USA

"Martin Fabian" <fabian...@s2.chalmers.se> wrote in message
news:3BA70804...@s2.chalmers.se...

Charles Kenyon

unread,
Sep 19, 2001, 12:39:37 AM9/19/01
to
You may want to take a look at post #3 (by Dave Rado) in the following
thread: <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&ic=1&th=bce07d7714769f5c,
6&seekm=531301c0eff3%248b23bb40%24a5e62ecf%40tkmsftngxa07#p>

I suspect that the article will be quite complex when it comes and like you
I'm eagerly awaiting it. In the meantime, you may want to look at the
following threads as well.

The following are some discussions on the Microsoft newsgroups on numbering:
Nightmare on ListNumbering Street <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&th=9e790fa7ed2886b3,18&ic
=1>
The Joy of Lists <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&th=811287ebce8fc203,15&ic
=1>
Relinking ListTemplates <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&th=2350746054c838e,12&ic=
1>
Outline numbering: restart doesn't restart <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&ic=1&th=2168093ed1c9eaed,
6&seekm=muq2hs47vabsq381n...@4ax.com#p>
Format Doesn't "Hold" <URL:
http://groups.google.com/groups?hl=en&lr=&safe=off&ic=1&th=3a351382011420bf,
5&seekm=RXz39CAcCC$4I...@syntagma.demon.co.uk#p>
(above list compiled by Dave Rado, Word MVP)

ListNumbering Street Revisited <URL:
http://groups.google.com/groups?hl=en&safe=off&th=57df77857e4993ce>

Hope this is some help,
--
Charles Kenyon

Word New User FAQ & Web Directory:
<URL: http://www.addbalance.com/word/index.htm>

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide)
<URL: http://www.addbalance.com/usersguide/index.htm>

See also the MVP FAQ: <URL: http://www.mvps.org/word/> which is awesome!
--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.

"Martin Fabian" <fabian...@s2.chalmers.se> wrote in message
news:3BA70804...@s2.chalmers.se...

Charles Kenyon

unread,
Oct 10, 2001, 8:34:31 PM10/10/01
to
While it is still "coming," it has been updated to include the information I
posted earlier (and more). See <URL:
http://www.mvps.org/word/FAQs/Numbering/CureListNumbering.htm>.
--
Charles Kenyon

Word New User FAQ & Web Directory:
<URL: http://www.addbalance.com/word/index.htm>

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide)
<URL: http://www.addbalance.com/usersguide/index.htm>

See also the MVP FAQ: <URL: http://www.mvps.org/word/> which is awesome!
--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.
"Martin Fabian" <fabian...@s2.chalmers.se> wrote in message
news:3BA70804...@s2.chalmers.se...

John McGhie [MVP]

unread,
Oct 15, 2001, 8:38:59 AM10/15/01
to fab...@s2.chalmers.se
Hi Martin:

Dave is in hospital at the moment, so he can't produce his article.

Here is the solution I use at work. This code has been tested in Word 97
and 2000 and Mac Word 2001 and X.

The usual caveats apply: This code will tear all your documents into tiny
little pieces, trash your files and erase your hard disk, and it may also do
bad things. If you use it, you assume responsibility for that.

I might also suggest that you need to understand list numbering well and be
good with VBA to use this solution, because you *will* need to adjust it to
your specifications before use.

Let me hasten to invite those who know VBA better than I to contribute all
the improvements they can!

Hope this helps


On 18/9/01 6:38 PM, in article 3BA70804...@s2.chalmers.se, "Martin
Fabian" <fabian...@s2.chalmers.se> wrote:

> Struggling with understanding Words list numbering I read John McGhie's
> excellent "Word's numbering explained" article on
> http://www.mvps.org/word. Thanks John, that explained a lot of the stuff
> I've been struggling with. This article contains a ref to "How to cure
> Word's List Numbering with a dose of VBA" written by Dave Rado. I
> thought this might help me solve some problems. However, that article is
> said to be "added here very soon". Does anyone know when?

Option Explicit
Dim ListName As String
Dim TargetList As ListTemplate
Dim i As Integer
Dim Response As Integer

Sub ApplyHeading1()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("Heading 1")
ListName = "OutlineHeadings"
Call FindAndApply(ListName)
End Sub
Sub ApplyHeading2()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("Heading 2")
ListName = "OutlineHeadings"
Call FindAndApply(ListName)
End Sub
Sub ApplyHeading3()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("Heading 3")
ListName = "OutlineHeadings"
Call FindAndApply(ListName)
End Sub
Sub ApplyHeading4()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("Heading 4")
ListName = "OutlineHeadings"
Call FindAndApply(ListName)
End Sub
Sub ApplyHeading5()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("Heading 5")
ListName = "OutlineHeadings"
Call FindAndApply(ListName)
End Sub
Sub ApplyASXBullets()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("List Bullet")
ListName = "OutlineBullets"
Call FindAndApply(ListName)
End Sub
Sub ApplyASXNumbers()
Selection.ParagraphFormat.Style = ActiveDocument.Styles("List Number")
ListName = "OutlineNumbers"
Call FindAndApply(ListName)
End Sub

Sub FindAndApply(ListName)
' This routine finds and applies the list if it already exists, or
' calls the create routine it if it doesn't

' Macro written 11 Dec 2000 by John McGhie

Begin:
For i = 1 To ActiveDocument.ListTemplates.Count
If ActiveDocument.ListTemplates(i).Name = ListName Then
Set TargetList = ActiveDocument.ListTemplates(i)
Exit For
End If
Next i

If TargetList Is Nothing Then
Response = MsgBox("Initialise Document?", vbOKCancel)
ElseIf ListName = "OutlineNumbers" Then
Selection.Range.ListFormat.ApplyListTemplate TargetList,
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList,
DefaultListBehavior:=wdWord9ListBehavior
Else
Selection.Range.ListFormat.ApplyListTemplate TargetList,
ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList,
DefaultListBehavior:=wdWord9ListBehavior
End If

If Response = 1 Then
Response = 0
Call SetUpListsandStyles.SetupMain
GoTo Begin
End If

End Sub

Option Explicit
Public Sub SetupMain()
'
' SetUpListsandStyles Macro
' Macro written 4/12/00 by John McGhie
'
' This Macro performs the following to fully define the List styles in a
document:
' 1) defines 27 styles, in the Heading, List Number and LIst Bullet series,
' 2) Specifies their formatting,
' 5) Sets up three List Templates
' 6) Assigns a name to that list template
' 3) attaches each style to a level in a List Template,
' 4) copies all styles to the Normal template.
'
' The problem is that unless list templates have names, and are
' explicitly attached to styles, they do not copy properly from
' document to document. This means documents inevitably corrupt
' when they are edited.
StatusBar = "Processing lists, please wait ..."
System.Cursor = wdCursorWait

' This macro can be very slow on a long document. The following
' speeds it up a lot by switching to Normal view, which suppresses the
pagination
' that would otherwise occur after every statement, and turns off
' screen updating which suppresses the screen refresh overhead.

Dim originalView As Long
originalView = ActiveDocument.ActiveWindow.View.Type
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdNormalView
Else
ActiveWindow.View.Type = wdNormalView
End If
Application.ScreenUpdating = False

Dim i As Integer
Dim thisDocument As String
thisDocument = ActiveDocument.FullName

Dim normalDot As String
normalDot = NormalTemplate.FullName

' Define five List Template objects to contain our five lists
Dim HeadingList As ListTemplate
Dim NumberList As ListTemplate
Dim BulletList As ListTemplate
Dim TabBulletList As ListTemplate
Dim TabNumberList As ListTemplate

' When we enter this macro, we know we did not find the list
' template we were looking for, but we don't yet know if
' others do exist. This routine finds any that exist.

For i = 1 To ActiveDocument.ListTemplates.Count
Select Case ActiveDocument.ListTemplates(i).Name
Case Is = "OutlineHeadings"
Set HeadingList = ActiveDocument.ListTemplates(i)
Case Is = "OutlineNumbers"
Set NumberList = ActiveDocument.ListTemplates(i)
If NumberList.ListLevels.Count < 5 Then
Set NumberList = Nothing
End If
Case Is = "OutlineBullets"
Set BulletList = ActiveDocument.ListTemplates(i)
Case Is = "TableBullets"
Set TabBulletList = ActiveDocument.ListTemplates(i)
Case Is = "TableNumbers"
Set TabNumberList = ActiveDocument.ListTemplates(i)
End Select
Next i

' Now we create any we did not find.
If HeadingList Is Nothing Then
Set HeadingList = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=True, Name:="OutlineHeadings")
End If
If NumberList Is Nothing Then
Set NumberList = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=True, Name:="OutlineNumbers")
End If
If BulletList Is Nothing Then
Set BulletList = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=True, Name:="OutlineBullets")
End If
If TabBulletList Is Nothing Then
Set NumberList = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=False, Name:="TableBullets")
End If
If TabNumberList Is Nothing Then
Set TabNumberList = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=False, Name:="TableNumbers")
End If

' Now make sure all the styles we need actually exist. These eight are not
' built-ins and we'll blow up on an error if they're not there.

Dim aStyle As Style
Dim DontCreate(7) As Boolean

For Each aStyle In ActiveDocument.Styles
If aStyle.NameLocal = "List Bullet 6" Then DontCreate(0) = True
If aStyle.NameLocal = "List Bullet 7" Then DontCreate(1) = True
If aStyle.NameLocal = "List Bullet 8" Then DontCreate(2) = True
If aStyle.NameLocal = "List Bullet 9" Then DontCreate(3) = True
If aStyle.NameLocal = "List Number 6" Then DontCreate(4) = True
If aStyle.NameLocal = "List Number 7" Then DontCreate(5) = True
If aStyle.NameLocal = "List Number 8" Then DontCreate(6) = True
If aStyle.NameLocal = "List Number 9" Then DontCreate(7) = True
Next aStyle
With ActiveDocument.Styles
If Not DontCreate(0) Then .Add Name:="List Bullet 6",
Type:=wdStyleTypeParagraph
If Not DontCreate(1) Then .Add Name:="List Bullet 7",
Type:=wdStyleTypeParagraph
If Not DontCreate(2) Then .Add Name:="List Bullet 8",
Type:=wdStyleTypeParagraph
If Not DontCreate(3) Then .Add Name:="List Bullet 9",
Type:=wdStyleTypeParagraph
If Not DontCreate(4) Then .Add Name:="List Number 6",
Type:=wdStyleTypeParagraph
If Not DontCreate(5) Then .Add Name:="List Number 7",
Type:=wdStyleTypeParagraph
If Not DontCreate(6) Then .Add Name:="List Number 8",
Type:=wdStyleTypeParagraph
If Not DontCreate(7) Then .Add Name:="List Number 9",
Type:=wdStyleTypeParagraph
End With

' Set up the "Heading 1 to 9" series of styles
' and their associated list template.
' We set up all parameters for Heading 1, then allow
' the rest of the series to inherit non-essential
' parameters. Spelling language, tab positions and indents are
' essential to our cause, so we set them explicitly. They
' otherwise copy from document to document and cause problems.

StatusBar = "Processing Headings..."

' Set up all 9 Heading styles
' Macro written 7/12/00 by John McGhie

StatusBar = "Processing Heading Styles..."

With ActiveDocument.Styles("Heading 1")
.AutomaticallyUpdate = False
.BaseStyle = ""
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Font
.Name = "Zurich Cn BT"
.Size = 22
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = True
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel1
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 2")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 1"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth300pt
.Color = wdColorGray25
End With
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Font
.Name = "Zurich Cn BT"
.Size = 16
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 32
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel2
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 3")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 2"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Font
.Name = "Zurich Cn BT"
.Size = 14
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 28
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel3
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 4")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 3"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Font
.Name = "Zurich Cn BT"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 24
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel4
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 5")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 4"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Font
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 10
.OutlineLevel = wdOutlineLevel5
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 6")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 5"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Font
.Name = "Zurich Cn BT"
.Size = 22
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = True
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel6
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 7")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 6"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth300pt
.Color = wdColorGray25
End With
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Font
.Name = "Zurich Cn BT"
.Size = 16
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.LeftIndent = 56.7
.RightIndent = 0
.SpaceBefore = 32
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = False
.FirstLineIndent = -56.7
.OutlineLevel = wdOutlineLevel7
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 8")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 7"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
With .Font
.Name = "Zurich Cn BT"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 14
.Animation = wdAnimationNone
End With
With .ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 10
.OutlineLevel = wdOutlineLevel8
With .TabStops
.ClearAll
.Add Position:=56.7, Alignment:=wdAlignTabLeft,
Leader:=wdTabLeaderSpaces
End With
End With
End With

With ActiveDocument.Styles("Heading 9")
.AutomaticallyUpdate = False
.BaseStyle = "Heading 7"
.NextParagraphStyle = "Body Text"
.LanguageID = wdEnglishAUS
.NoProofing = False
.ParagraphFormat.OutlineLevel = wdOutlineLevel9
End With

' Set up all nine levels of the Heading list template
With HeadingList.ListLevels(1)
.NumberFormat = "%1"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "Heading 1"
End With
With HeadingList.ListLevels(2)
.NumberFormat = "%1.%2"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 1
.StartAt = 1
.LinkedStyle = "Heading 2"
End With
With HeadingList.ListLevels(3)
.NumberFormat = "%1.%2.%3"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 2
.StartAt = 1
.LinkedStyle = "Heading 3"
End With
With HeadingList.ListLevels(4)
.NumberFormat = "%1.%2.%3.%4"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 3
.StartAt = 1
.LinkedStyle = "Heading 4"
End With
With HeadingList.ListLevels(5)
.NumberFormat = "%1.%2.%3.%4.%5"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 4
.StartAt = 1
.LinkedStyle = "Heading 5"
End With
With HeadingList.ListLevels(6)
.NumberFormat = "Appendix %6"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleUppercaseLetter
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = 56.7
.ResetOnHigher = 5
.StartAt = 1
.LinkedStyle = "Heading 6"
End With
With HeadingList.ListLevels(7)
.NumberFormat = "%6.%7"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = wdUndefined
.ResetOnHigher = 6
.StartAt = 1
.LinkedStyle = "Heading 7"
End With
With HeadingList.ListLevels(8)
.NumberFormat = "%6.%7.%8"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = wdUndefined
.ResetOnHigher = 7
.StartAt = 1
.LinkedStyle = "Heading 8"
End With
With HeadingList.ListLevels(9)
.NumberFormat = ""
.TrailingCharacter = wdTrailingNone
.NumberStyle = wdListNumberStyleNone
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 56.7
.TabPosition = wdUndefined
.ResetOnHigher = 8
.StartAt = 1
.LinkedStyle = "Heading 9"
End With

' Set up the "List Number 1 to 9" series of styles
' and their associated list template.

' Set up the List Number styles

StatusBar = "Processing Number Styles..."

With ActiveDocument.Styles("List Number")
.AutomaticallyUpdate = False
.BaseStyle = "Body Text"
.NextParagraphStyle = "List Number"
End With
With ActiveDocument.Styles("List Number").ParagraphFormat
.LeftIndent = 70
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=70
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 2")
.AutomaticallyUpdate = False
.BaseStyle = "List Number"
.NextParagraphStyle = "List Number 2"
End With
With ActiveDocument.Styles("List Number 2").ParagraphFormat
.LeftIndent = 90
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=90
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 3")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 2"
.NextParagraphStyle = "List Number 3"
End With
With ActiveDocument.Styles("List Number 3").ParagraphFormat
.LeftIndent = 110
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=110
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 4")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 3"
.NextParagraphStyle = "List Number 4"
End With
With ActiveDocument.Styles("List Number 4").ParagraphFormat
.LeftIndent = 130
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=130
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 5")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 4"
.NextParagraphStyle = "List Number 5"
End With
With ActiveDocument.Styles("List Number 5").ParagraphFormat
.LeftIndent = 150
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=150
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 6")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 5"
.NextParagraphStyle = "List Number 6"
End With
With ActiveDocument.Styles("List Number 6").ParagraphFormat
.LeftIndent = 170
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=170
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 7")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 6"
.NextParagraphStyle = "List Number 7"
End With
With ActiveDocument.Styles("List Number 7").ParagraphFormat
.LeftIndent = 210
.RightIndent = 0
.SpaceBefore = 0
With .TabStops
.ClearAll
.Add Position:=210
End With
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 8")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 7"
.NextParagraphStyle = "List Number 8"
End With
With ActiveDocument.Styles("List Number 8").ParagraphFormat
.LeftIndent = 230
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=230
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Number 9")
.AutomaticallyUpdate = False
.BaseStyle = "List Number 8"
.NextParagraphStyle = "List Number 9"
End With
With ActiveDocument.Styles("List Number 9").ParagraphFormat
.LeftIndent = 250
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=250
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With

' Set up all nine levels in the Number Styles list

StatusBar = "Processing Numbers..."

With NumberList.ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 70
.Alignment = wdListLevelAlignLeft
.TextPosition = 90
.TabPosition = 90
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "List Number"
End With
With NumberList.ListLevels(2)
.NumberFormat = "%2)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = 90
.Alignment = wdListLevelAlignLeft
.TextPosition = 110
.TabPosition = 110
.ResetOnHigher = 1
.StartAt = 1
.LinkedStyle = "List Number 2"
End With
With NumberList.ListLevels(3)
.NumberFormat = "%3)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseRoman
.NumberPosition = 110
.Alignment = wdListLevelAlignLeft
.TextPosition = 130
.TabPosition = 130
.ResetOnHigher = 2
.StartAt = 1
.LinkedStyle = "List Number 3"
End With
With NumberList.ListLevels(4)
.NumberFormat = "(%4)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 130
.Alignment = wdListLevelAlignLeft
.TextPosition = 150
.TabPosition = 150
.ResetOnHigher = 3
.StartAt = 1
.LinkedStyle = "List Number 4"
End With
With NumberList.ListLevels(5)
.NumberFormat = "(%5)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = 150
.Alignment = wdListLevelAlignLeft
.TextPosition = 170
.TabPosition = 170
.ResetOnHigher = 4
.StartAt = 1
.LinkedStyle = "List Number 5"
End With
With NumberList.ListLevels(6)
.NumberFormat = "(%6)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseRoman
.NumberPosition = 170
.Alignment = wdListLevelAlignLeft
.TextPosition = 190
.TabPosition = 190
.ResetOnHigher = 5
.StartAt = 1
.LinkedStyle = "List Number 6"
End With
With NumberList.ListLevels(7)
.NumberFormat = "%7."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 190
.Alignment = wdListLevelAlignLeft
.TextPosition = 210
.TabPosition = 210
.ResetOnHigher = 6
.StartAt = 1
.LinkedStyle = "List Number 7"
End With
With NumberList.ListLevels(8)
.NumberFormat = "%8."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = 210
.Alignment = wdListLevelAlignLeft
.TextPosition = 230
.TabPosition = 230
.ResetOnHigher = 7
.StartAt = 1
.LinkedStyle = "List Number 8"
End With
With NumberList.ListLevels(9)
.NumberFormat = "%9."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseRoman
.NumberPosition = 230
.Alignment = wdListLevelAlignLeft
.TextPosition = 250
.TabPosition = 250
.ResetOnHigher = 8
.StartAt = 1
.LinkedStyle = "List Number 9"
End With


' Set up the "List Bullet 1 to 9" series of styles
' and their associated list template.

StatusBar = "Processing Bullets ..."


' Set up all nine list bullet styles
'

StatusBar = "Processing Bullet Styles..."

With ActiveDocument.Styles("List Bullet")
.AutomaticallyUpdate = False
.BaseStyle = "Body Text"
.NextParagraphStyle = "List Bullet"
End With
With ActiveDocument.Styles("List Bullet").ParagraphFormat
.LeftIndent = 70
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=70
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 2")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet"
.NextParagraphStyle = "List Bullet 2"
End With
With ActiveDocument.Styles("List Bullet 2").ParagraphFormat
.LeftIndent = 90
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=90
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 3")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 2"
.NextParagraphStyle = "List Bullet 3"
End With
With ActiveDocument.Styles("List Bullet 3").ParagraphFormat
.LeftIndent = 110
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=110
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 4")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 3"
.NextParagraphStyle = "List Bullet 4"
End With
With ActiveDocument.Styles("List Bullet 4").ParagraphFormat
.LeftIndent = 130
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=130
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 5")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 4"
.NextParagraphStyle = "List Bullet 5"
End With
With ActiveDocument.Styles("List Bullet 5").ParagraphFormat
.LeftIndent = 150
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=150
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 6")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 5"
.NextParagraphStyle = "List Bullet 6"
End With
With ActiveDocument.Styles("List Bullet 6").ParagraphFormat
.LeftIndent = 170
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=170
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 7")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 6"
.NextParagraphStyle = "List Bullet 7"
End With
With ActiveDocument.Styles("List Bullet 7").ParagraphFormat
.LeftIndent = 210
.RightIndent = 0
.SpaceBefore = 0
With .TabStops
.ClearAll
.Add Position:=210
End With
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 8")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 7"
.NextParagraphStyle = "List Bullet 8"
End With
With ActiveDocument.Styles("List Bullet 8").ParagraphFormat
.LeftIndent = 230
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=230
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
With ActiveDocument.Styles("List Bullet 9")
.AutomaticallyUpdate = False
.BaseStyle = "List Bullet 8"
.NextParagraphStyle = "List Bullet 9"
End With
With ActiveDocument.Styles("List Bullet 9").ParagraphFormat
.LeftIndent = 250
.RightIndent = 0
With .TabStops
.ClearAll
.Add Position:=250
End With
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 5
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -20
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With

' Set up all the Bulleted List Templates
With BulletList.ListLevels(1)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 70
.Alignment = wdListLevelAlignLeft
.TextPosition = 90
.TabPosition = 90
.ResetOnHigher = 0
.StartAt = 1
.Font.Name = "Symbol"
.LinkedStyle = "List Bullet"
End With
With BulletList.ListLevels(2)
.NumberFormat = "€"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 90
.Alignment = wdListLevelAlignLeft
.TextPosition = 110
.TabPosition = 110
.ResetOnHigher = 1
.StartAt = 1
.Font.Name = "ClassGarmnd BT"
.LinkedStyle = "List Bullet 2"
End With
With BulletList.ListLevels(3)
.NumberFormat = ChrW(61656)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 110
.Alignment = wdListLevelAlignLeft
.TextPosition = 130
.TabPosition = 130
.ResetOnHigher = 2
.StartAt = 1
.Font.Name = "Wingdings"
.LinkedStyle = "List Bullet 3"
End With
With BulletList.ListLevels(4)
.NumberFormat = ChrW(61692)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 130
.Alignment = wdListLevelAlignLeft
.TextPosition = 150
.TabPosition = 150
.ResetOnHigher = 3
.StartAt = 1
.Font.Name = "Wingdings"
.LinkedStyle = "List Bullet 4"
End With
With BulletList.ListLevels(5)
.NumberFormat = ChrW(61608)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 150
.Alignment = wdListLevelAlignLeft
.TextPosition = 170
.TabPosition = 170
.ResetOnHigher = 4
.StartAt = 1
.Font.Name = "Symbol"
.LinkedStyle = "List Bullet 5"
End With
With BulletList.ListLevels(6)
.NumberFormat = ChrW(61656)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 170
.Alignment = wdListLevelAlignLeft
.TextPosition = 190
.TabPosition = 190
.ResetOnHigher = 5
.StartAt = 1
.Font.Name = "Wingdings"
.LinkedStyle = "List Bullet 6"
End With
With BulletList.ListLevels(7)
.NumberFormat = ChrW(61607)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 190
.Alignment = wdListLevelAlignLeft
.TextPosition = 210
.TabPosition = 210
.ResetOnHigher = 6
.StartAt = 1
.Font.Name = "Wingdings"
.LinkedStyle = "List Bullet 7"
End With
With BulletList.ListLevels(8)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 210
.Alignment = wdListLevelAlignLeft
.TextPosition = 230
.TabPosition = 230
.ResetOnHigher = 7
.StartAt = 1
.Font.Name = "Symbol"
.LinkedStyle = "List Bullet 8"
End With
With BulletList.ListLevels(9)
.NumberFormat = ChrW(61608)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = 230
.Alignment = wdListLevelAlignLeft
.TextPosition = 250
.TabPosition = 250
.ResetOnHigher = 8
.StartAt = 1
.Font.Name = "Symbol"
.LinkedStyle = "List Bullet 9"
End With

Application.ScreenUpdating = True
StatusBar = "Finished..."
ActiveDocument.ActiveWindow.View.Type = originalView
System.Cursor = wdCursorNormal

End Sub

--
Please post replies to the newsgroup to maintain the thread.

John McGhie, Microsoft MVP: Word for Macintosh and Word for Windows
Consultant Technical Writer
<jo...@mcghie-information.com.au>
+61 4 1209 1410; Sydney, Australia: GMT + 10 hrs

0 new messages