Problem with numbering

A

Associates

Hi,

I was wondering if i could get some help here with style and numbering for
word 03. I've been writing some VBA codes that would insert new sections as
well as sub-sections.

For example, in a word doc,
Section 1 Test Section1
1.1 My Test Section11
1.2 My Test Section12
and so on

This works so far. However, when inserting another section break, it shows
Section 2 Test Section2
1.3 My Test Section21

It seems that it's unable to detect which section it has been up to. It just
remembers that it's still under section 1. There has been disconnection
between Section and Sub-Section. Greatly appreciate if anyone might be able
to show how to get around this problem.

Here is the code for "insert a section"
Sub InsertSection()

' Insert a section break to begin the new section.
Selection.InsertBreak Type:=wdSectionBreakOddPage

' Insert a heading for the new section.
Selection.Style = ActiveDocument.Styles("Section Heading 1")

' Insert the heading's text based on InputBox entry.
' Add a paragraph break to return to "Normal" text.

With ListGalleries(wdOutlineNumberGallery).ListTemplates(4).ListLevels(1)
.NumberFormat = "Section %1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0)
.TabPosition = CentimetersToPoints(2.9)
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = True
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdColorGreen
.Size = 16
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Garamond"
End With
.LinkedStyle = "Section Heading 1"
End With

ListGalleries(wdOutlineNumberGallery).ListTemplates(4).Name = ""
Selection.Range.ListFormat.ApplyListTemplate
ListTemplate:=ListGalleries( _
wdOutlineNumberGallery).ListTemplates(4),
ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

Selection.TypeText Text:=InputBox("Please enter the section heading:",
"Enter Section Heading")
Selection.TypeParagraph

End Sub
===============================================

Sub marginstyle()

Dim styleName As String
Dim oStyle As Style

styleName = "Section Heading 1"
'Create/Setup the style
For Each oStyle In ActiveDocument.Styles
If oStyle.NameLocal = styleName Then GoTo Setup
Next oStyle
ActiveDocument.Styles.Add Name:=styleName, Type:=wdStyleTypeParagraph

Setup:
With ActiveDocument.Styles(styleName)
.AutomaticallyUpdate = False
.BaseStyle = ActiveDocument.Styles(wdStyleHeading1)
.NextParagraphStyle = "Normal"
End With
With ActiveDocument.Styles(styleName).Font
.Size = 16
.ColorIndex = wdGreen
.Name = "Garamond"
End With

MsgBox "First Style setup completed"
End Sub
==================================================

Here is the code for "insert Sub Section"
Sub subSectionSetup()
With ActiveDocument.Styles("Heading 1")
.AutomaticallyUpdate = False
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal"
End With
With ActiveDocument.Styles("Heading 2")
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal"
End With
With ActiveDocument.Styles("Heading 1")
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal"
End With
With ActiveDocument.Styles("Heading 3")
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal"
End With
ActiveDocument.Styles.Add Name:="Document Heading 2", Type:= _
wdStyleTypeParagraph
ActiveDocument.Styles("Document Heading 2").AutomaticallyUpdate = True
With ActiveDocument.Styles("Document Heading 2").Font
.Name = "Garamond"
.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 = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("Document Heading 2").ParagraphFormat
.LeftIndent = CentimetersToPoints(1.02)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 12
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = True
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(-1.02)
.OutlineLevel = wdOutlineLevel2
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
ActiveDocument.Styles("Document Heading 2"). _
NoSpaceBetweenParagraphsOfSameStyle = False
ActiveDocument.Styles("Document Heading 2").ParagraphFormat.TabStops. _
ClearAll
With ActiveDocument.Styles("Document Heading 2").ParagraphFormat
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With
ActiveDocument.Styles("Document Heading 2").LanguageID = wdEnglishUK
ActiveDocument.Styles("Document Heading 2").NoProofing = False
ActiveDocument.Styles("Document Heading 2").Frame.Delete
With ActiveDocument.Styles("Document Heading 2").Font
.Name = "Garamond"
.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 = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("Document Heading 2")
.AutomaticallyUpdate = True
.BaseStyle = "Heading 2"
.NextParagraphStyle = "Normal"
End With

ActiveDocument.Styles.Add Name:="Document Heading 3", Type:= _
wdStyleTypeParagraph
ActiveDocument.Styles("Document Heading 3").AutomaticallyUpdate = True
With ActiveDocument.Styles("Document Heading 3").Font
.Name = "Garamond"
.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 = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("Document Heading 3").ParagraphFormat
.LeftIndent = CentimetersToPoints(2.77)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 12
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = True
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(-2.77)
.OutlineLevel = wdOutlineLevel3
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
ActiveDocument.Styles("Document Heading 3"). _
NoSpaceBetweenParagraphsOfSameStyle = False
With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(1)
.NumberFormat = "Section %1"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.ResetOnHigher = 0
.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 = "Document Heading 2"
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(2)
.NumberFormat = "%1.%2"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(1.02)
'.TabPosition = CentimetersToPoints(1.02)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.ResetOnHigher = 1
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = False
.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 = "Document Heading 2"
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(3)
.NumberFormat = "%1.%2.%3"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(2.77)
'.TabPosition = CentimetersToPoints(2.77)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.ResetOnHigher = 2
.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 = "Document Heading 3"
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).ListLevels(4)
.NumberFormat = "%1.%2.%3.%4"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(1.52)
'.TabPosition = CentimetersToPoints(1.52)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.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(7).ListLevels(5)
.NumberFormat = "%1.%2.%3.%4.%5"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(1.78)
'.TabPosition = CentimetersToPoints(1.78)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.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(7).ListLevels(6)
.NumberFormat = "%1.%2.%3.%4.%5.%6"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(2.03)
'.TabPosition = CentimetersToPoints(2.03)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.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(7).ListLevels(7)
.NumberFormat = "%1.%2.%3.%4.%5.%6.%7"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(2.29)
'.TabPosition = CentimetersToPoints(2.29)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.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(7).ListLevels(8)
.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(2.54)
'.TabPosition = CentimetersToPoints(2.54)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.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(7).ListLevels(9)
.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8.%9"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
'.TextPosition = CentimetersToPoints(2.79)
'.TabPosition = CentimetersToPoints(2.79)
.TextPosition = CentimetersToPoints(0.5)
.TabPosition = CentimetersToPoints(0.5)
.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
ActiveDocument.Styles("Document Heading 3").LinkToListTemplate _

ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _
ListLevelNumber:=3
With ActiveDocument.Styles("Document Heading 3")
.AutomaticallyUpdate = True
.BaseStyle = "Heading 3"
.NextParagraphStyle = "Normal"
End With

MsgBox "Second Style setup completed"
End Sub
===============================================

Sub AutoNew()

Call marginstyle
Call subSectionSetup
End Sub
================================================

Sub InsertSubSection1()

Selection.TypeText Text:=InputBox("Please enter the sub-section heading
2:", "Enter Section Heading")

Selection.Style = ActiveDocument.Styles("Document Heading 2")
End Sub
=================================================

Sub InsertSubSection2()

Selection.TypeText Text:=InputBox("Please enter the sub-section heading
3:", "Enter Section Heading")

Selection.Style = ActiveDocument.Styles("Document Heading 3")
End Sub

Thank you in advance
 
S

Shauna Kelly

Hi Associates

You will need to do some serious work to get this working the way you
want.

First, I suggest you read the following, and get your numbering working
through the user interface before trying to do it in code:
How to create numbered headings or outline numbering in your Microsoft
Word document
http://www.ShaunaKelly.com/word/numbering/OutlineNumbering.html

Next, read the following article that will show you how to reduce the
amount of code when you have used the macro recorder:
http://word.mvps.org/FAQs/MacrosVBA/ModifyRecordedMacro.htm
How to modify a recorded macro

Finally, never, in any circumstances, use the ListGalleries in code. The
ListGalleries object refers to the 6 little panes you see in the Bullets
and Numbering dialog. The ListGalleries store what the current user's
last-used numbering preferences are. They are stored in the registry of
the machine. So what is in ListGallery 1 right now might change in 5
minutes. And it will never be the same from one machine to another.

For more information about that, see
Word's numbering explained
http://www.word.mvps.org/FAQs/Numbering/WordsNumberingExplained.htm


Hope this helps. Write back if you need further help with specifics.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word
 

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

Macro with find/ replace steps is not behaving consistently 3
Please help!!! No replies - Posting query again 0
Bullet Styles Macro 0
Macro Error 3
same indentation for bulletpoint and bulletnumber 10
how do I loop this macro? 2
VB Code for Outline Numbering and Outline Bullets 1
how can i report to microsoft a bug that i foubd in Word 2007 0

Top