VB Code for Outline Numbering and Outline Bullets

D

Debra Ann

I have the following code that seems to change the indents depending on what
the person used for an outline previously. I even reset the list before I
start but eventhough the code says to start the number position at 1", the
next time it is used it may start somewhere else. How can I control the
indents?

Sub NumberOutline()

ListGalleries(wdOutlineNumberGallery).Reset 1

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(1)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(1.25)
.TabPosition = InchesToPoints(1.25)
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = False
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)
.NumberFormat = "%2."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = InchesToPoints(1.25)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(1.5)
.TabPosition = InchesToPoints(1.5)
.ResetOnHigher = 1
.StartAt = 1
With .Font
.Bold = False
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(3)
.NumberFormat = "%3)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(1.5)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(1.75)
.TabPosition = InchesToPoints(1.75)
.ResetOnHigher = 2
.StartAt = 1
With .Font
.Bold = False
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(4)
.NumberFormat = "%4)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = InchesToPoints(1.75)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(2)
.TabPosition = InchesToPoints(2)
.ResetOnHigher = 3
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(5)
.NumberFormat = "(%5)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(2)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(2.25)
.TabPosition = InchesToPoints(2.25)
.ResetOnHigher = 4
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(6)
.NumberFormat = "(%6)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = InchesToPoints(2.25)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(2.5)
.TabPosition = InchesToPoints(2.5)
.ResetOnHigher = 5
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(7)
.NumberFormat = "%7."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(2.5)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(2.75)
.TabPosition = InchesToPoints(2.75)
.ResetOnHigher = 6
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(8)
.NumberFormat = "%8."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = InchesToPoints(2.75)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(3)
.TabPosition = InchesToPoints(3)
.ResetOnHigher = 7
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(9)
.NumberFormat = "%9)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(3)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(3.25)
.TabPosition = InchesToPoints(3.25)
.ResetOnHigher = 8
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = ""

Selection.Range.ListFormat.ApplyListTemplate
ListTemplate:=ListGalleries( _
wdOutlineNumberGallery).ListTemplates(1),
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

End Sub
 
S

Stefan Blom

You cannot build reliable outline numbering on the list galleries. You
have to create a list template in the document, format its numbering
levels as desired and then link it to styles.

Something like this (including just the first level of numbering):

Sub CreateListNumbering()
Dim LT As ListTemplate
Dim mylist As ListTemplate

For Each LT In ActiveDocument.ListTemplates
If LT.Name = "my list" Then
Set mylist = LT
Exit For
End If
Next LT

If mylist Is Nothing Then
Set mylist = ActiveDocument.ListTemplates.Add _
(OutlineNumbered:=True, Name:="my list")

End If

With mylist
With .ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(1)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(1.25)
.TabPosition = InchesToPoints(1.25)
.ResetOnHigher = 0
.StartAt = 1
'Set a linked style:
.LinkedStyle = "Heading 1"
End With

'Repeat With .ListLevels(n)
'for n=2,...,9
'and set the desired options
'for each level

End With

End Sub

Then use styles to apply numbering in the document.

--
Stefan Blom
Microsoft Word MVP


in message
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

same indentation for bulletpoint and bulletnumber 10
Please help!!! No replies - Posting query again 0
Bullet Styles Macro 0
Macro Error 3
Macro with find/ replace steps is not behaving consistently 3
how do I loop this macro? 2
Problem with numbering 1
table/numbering/format problem 0

Top