A very ellusive gremlin

[Greg Maxey]

Hello,

I have been monkeying around with some VBA that Margaret Aldis has on the
MVP FAQ site for restarting list numbering. I thought I would try to add a
option for the user to select an existing top level header style (or use the
dummy style that Margaret proposes) before buildling the list numbering
template. I am having a problem and was hoping someone could help me out.
The code is posted below.

My Heading 1 style is currently out of the box configuration (e.g., no
indents, hanging indents or tabs) however, when I run this code and type in
Heading 1 as my selected top level style, when the the line .LinkedStyle =
oStyleName in the snipet below runs the Heading 1 style takes on a .25"
hanging indent and a .25 in tab.

With ActiveDocument.ListTemplates(myListTemplate).ListLevels(1)
.NumberFormat = ""
.NumberStyle = wdListNumberStyleNone
.LinkedStyle = oStyleName

I am trying to get this so that "no changes" are made to the users selected
top level style. Any ideas?

Thanks
Sub MyNumberList()
Dim oStyleName As String
Dim myListTemplate As String
Dim oStyle As Style
Dim oTempString As String
Dim oListTemplate As ListTemplate

Retry:
oStyleName = InputBox("Type in the name of the unnumbered heading" _
& " style that you will use to separate lists and restart" _
& " list numbering." & vbCr & vbCr & "Or leave this field" _
& " blank to create a dummy style for this purpose.", "Style")
myListTemplate = "My List Template"
On Error GoTo Handler
oTempString = ActiveDocument.Styles(oStyleName).Description
With ActiveDocument.Styles(oStyleName)
.AutomaticallyUpdate = False
.NextParagraphStyle = wdStyleListNumber
If oStyleName = "My Restart List" Then
.BaseStyle = ""
.Font.Color = wdColorLightBlue
With .ParagraphFormat
.LineSpacingRule = wdLineSpaceSingle
.WidowControl = False
.KeepWithNext = True
.KeepTogether = True
.OutlineLevel = wdOutlineLevelBodyText
End With
With .Frame
.TextWrap = True
.WidthRule = wdFrameAuto
.HeightRule = wdFrameAuto
.HorizontalPosition = InchesToPoints(-0.5)
.LockAnchor = False
End With
End If
End With
For Each oListTemplate In ActiveDocument.ListTemplates
If oListTemplate.Name = myListTemplate Then GoTo Format
Next oListTemplate
Set oListTemplate = Nothing
Set oListTemplate = ActiveDocument.ListTemplates _
.Add(OutlineNumbered:=True)
oListTemplate.Name = myListTemplate
Format:
With ActiveDocument.ListTemplates(myListTemplate).ListLevels(1)
.NumberFormat = ""
.NumberStyle = wdListNumberStyleNone
.LinkedStyle = oStyleName
.TrailingCharacter = wdTrailingNone
.TextPosition = InchesToPoints(0)
.TabPosition = InchesToPoints(0)
.NumberPosition = InchesToPoints(0)
.Alignment = wdListLevelAlignLeft
.ResetOnHigher = True
.StartAt = 1
If oStyleName = "My Restart List" Then
.TextPosition = InchesToPoints(-0.5)
.TrailingCharacter = wdTrailingTab
End If
End With
With ActiveDocument.ListTemplates(myListTemplate).ListLevels(2)
.NumberFormat = "%2."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(0.15)
.Alignment = wdListLevelAlignRight
.TextPosition = InchesToPoints(0.3)
.TabPosition = InchesToPoints(0.3)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = ActiveDocument.Styles(wdStyleListNumber).NameLocal
End With
With ActiveDocument.ListTemplates(myListTemplate).ListLevels(3)
.NumberFormat = "%3."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleLowercaseLetter
.NumberPosition = InchesToPoints(0.3)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(0.5)
.TabPosition = InchesToPoints(0.5)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = ActiveDocument.Styles(wdStyleListNumber2).NameLocal
End With
With ActiveDocument.ListTemplates(myListTemplate).ListLevels(4)
.NumberFormat = "%4)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(0.65)
.Alignment = wdListLevelAlignRight
.TextPosition = InchesToPoints(0.75)
.TabPosition = InchesToPoints(0.75)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = ActiveDocument.Styles(wdStyleListNumber3).NameLocal
End With
Exit Sub
Handler:
If Len(oStyleName) = 0 Then
oStyleName = "My Restart List"
ActiveDocument.Styles.Add Name:=oStyleName, Type:=wdStyleTypeParagraph
Resume Next
Else
MsgBox "That style does not exist in the current document."
Resume Retry
End If
Resume Next
End Sub

 

[Word Heretic]

G'day "Greg Maxey" <[email protected]>,

STOP - DESIST - HALT!!!




Mate, NEVER EVER refer to a LT by NAME! You said:

With ActiveDocument.ListTemplates(myListTemplate).ListLevels(3)

NO NO NO NO NO NO NO NO NO NO NO NO etc ad nauseum




Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Greg Maxey reckoned:

 

[Greg]

Steve,

Would you care to elaborate? Is naming the LT the cause for the
unsuspected introduction of the the indents and tabs in ListLevels(1)?
If I don't refer to myListTemplate by name then what do I refer to it
as when I try to format the various list levels?

 

[Word Heretic]

G'day "Greg" <[email protected]>,

Use a common routine like this:

Public Function ListTemplateIndex(ListTemplateName As String) As
ListTemplate
'Returns the List Template with the provided name
'If the LT doesn't exist, it creates it as an outline list

Dim LT As ListTemplate

For Each LT In Source.ListTemplates
If LT.Name = ListTemplateName Then
Set ListTemplateIndex = LT
Exit For
End If
Next

If ListTemplateIndex Is Nothing Then
Set ListTemplateIndex = Source.ListTemplates.Add(True)
ListTemplateIndex.Name = ListTemplateName
End If

Specifically, what is happening is that when you reference an LT by
its name, you create a whole new LT.

Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Greg reckoned:

 

[Greg Maxey]

Steve,

When I try to run your piece of code it causes a compile error on
Source.ListTemplates.

Sub CallMacro()
Dim myList As String
myList = "Greg"
ListTemplateIndex myList
End Sub

Public Function ListTemplateIndex(ListTemplateName As String) As
ListTemplate
'Returns the List Template with the provided name
'If the LT doesn't exist, it creates it as an outline list
Dim LT As ListTemplate
For Each LT In Source.ListTemplates
If LT.Name = ListTemplateName Then
Set ListTemplateIndex = LT
Exit For
End If
Next
If ListTemplateIndex Is Nothing Then
Set ListTemplateIndex = Source.ListTemplates.Add(True)
ListTemplateIndex.Name = ListTemplateName
End If
End Function

 

[Word Heretic]

G'day "Greg Maxey" <[email protected]>,

My Apols. To make this generic I made that var a global to set from
elsewhere, eg include a line like

Set SourceListTemplates = ActiveDocument.ListTemplates

Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Greg Maxey reckoned:

 

[Greg]

Thanks, Steve.

 

[Word Heretic]

G'day "Greg" <[email protected]>,

Always a pleasure master maxey Keep ya sheets tight!

Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Greg reckoned: