Hope someone can save my sanity...

I created a template containing lots of 'Outlined numbered' styles with
picture bullets.  I did it all with VBA, 'cause I read in the
newsgroups all kinds of horror stories about lists and our previous
template was indeed starting to unravel...

Everything seemed to work OK, but then I wanted to modify some of the
styles.  Again, I used my VBA procedures to do the update (the same
used to create the styles) and changes appear OK in the template. But
when I reopen the template (after closing Word) some of the picture
bullets are not there! The style's list levels still contains the
PictureBullet object, but it is not displayed.

I copied the code used below.  I'm working in Word 2003 SP1 on Windows
XP SP2.  The images I use for my picture bullets are .WMF.

Thank you for reading me !

- - - - - - - - - - - -
Option Explicit

Const cTabWidthPTS As Single = 19!
Const cSpcBullParaPTS As Single = 4!
Const cBullPath As String = "C:\My Template\Images\"

Dim vTabLVL(1 To 10) As Single

Sub Set_Document()
 If vTabLVL(2) <> cTabWidthPTS Then SetTabLVLs
 ActiveDocument.DefaultTabStop = vTabLVL(2)

 Set_ParagraphTextGz_All
 Set_ActionGz
End Sub

Sub Set_ParagraphTextGz_All()
 If vTabLVL(2) <> cTabWidthPTS Then SetTabLVLs
 SetParagraphTextGz "Paragraph Text Gz", "", vTabLVL(1)
 SetParagraphTextGz "Normal", "", vTabLVL(1)
 SetParagraphTextGz "Paragraph Text L2 Gz", "Paragraph Text Gz", _
                    vTabLVL(2)
 SetParagraphTextGz "Paragraph Text L3 Gz", "Paragraph Text Gz", _
                    vTabLVL(3)
 SetParagraphTextGz "Paragraph Text L4 Gz", "Paragraph Text Gz", _
                    vTabLVL(4)
End Sub

Sub Set_ActionGz()
 Dim vNames() As Variant
 vNames = Array("1.wmf", "2.wmf")
 x_SetBulletStyle "Action Gz", 12, 12, "Action", -1, 1, vNames
End Sub

Private Sub SetTabLVLs()
 Dim I
 For I = 1 To 10
   vTabLVL(I) = (I - 1) * cTabWidthPTS
 Next I
End Sub

Private Sub SetParagraphTextGz(sStyleName As String, _
                              sBaseStyle As String, _
                              sngIndent As Single)
 Dim STY As Style

 On Error Resume Next
 Set STY = ActiveDocument.Styles(sStyleName)
 On Error GoTo 0
 If STY Is Nothing Then Set STY = _
                        ActiveDocument.Styles.Add(sStyleName, 1)

 With STY
   .LanguageID = wdEnglishUS
   .AutomaticallyUpdate = False: .NoProofing = 0: .Hidden = False
   .NoSpaceBetweenParagraphsOfSameStyle = False

   .BaseStyle = sBaseStyle
   .NextParagraphStyle = sStyleName
   .Borders.Enable = False

   x_BaseFont .Font
   x_BaseParagraphFormat .ParagraphFormat
   .ParagraphFormat.LeftIndent = sngIndent

   With .Shading
     .BackgroundPatternColor = wdColorAutomatic
     .ForegroundPatternColor = wdColorAutomatic
     .Texture = wdTextureNone
   End With ' .Shading

   .Frame.Delete
 End With ' STY
End Sub

Private Sub x_BaseFont(FNT As Font)
 With FNT
   .AllCaps = 0: .Animation = 0: .DoubleStrikeThrough = 0
   .Hidden = 0
   .Name = "Tahoma": .Position = 0: .Scaling = 100: .Shadow = 0
   .SmallCaps = 0: .StrikeThrough = 0: .Subscript = 0
   .Superscript = 0

   .Outline = 0
   .Size = 10
   .Color = wdColorAutomatic

   .Bold = 0
   .Italic = 0
   .Underline = 0
   .UnderlineColor = wdColorAutomatic

   .Spacing = 0
   .Kerning = 0
 End With ' FNT
End Sub

Private Sub x_BaseParagraphFormat(PFMT As ParagraphFormat)
 With PFMT
   .AutoAdjustRightIndent = -1
   .BaseLineAlignment = wdBaselineAlignAuto
   .CharacterUnitFirstLineIndent = 0: .CharacterUnitLeftIndent = 0
   .CharacterUnitRightIndent = 0: .DisableLineHeightGrid = 0
   .HalfWidthPunctuationOnTopOfLine = 0: .HangingPunctuation = -1
   .Hyphenation = -1: .LineUnitAfter = 0: .LineUnitBefore = 0
   .NoLineNumber = 0: .ReadingOrder = 1
   .WidowControl = -1: .WordWrap = -1
   .SpaceBeforeAuto = 0: .SpaceAfterAuto = 0

   .Alignment = wdAlignParagraphLeft
   .OutlineLevel = wdOutlineLevelBodyText

   .FirstLineIndent = 0
   .LeftIndent = 0
   .RightIndent = 0

   .KeepTogether = 0
   .KeepWithNext = 0
   .PageBreakBefore = 0

   .LineSpacingRule = wdLineSpaceSingle
   .LineSpacing = 12

   .SpaceAfter = 3
   .SpaceBefore = 3

   .TabStops.ClearAll
 End With ' PFMT
End Sub

Private Sub x_SetBulletStyle(aStyleName As String, _
 aBullWidth As Single, aBullFontSize As Single, _
 aBullFileStart As String, aBasePos As Long, _
 aGalleryNum As Long, aBullFileEnds() As Variant, _
 Optional aBorderColor As Long = -1, _
 Optional aSpaceBefAft As Long = 3)

 Const sBaseStyle As String = "Paragraph Text Gz"

 Dim STY As Style, LTP As ListTemplate, sLtpName As String
 Dim sNextPara As String, sFile As String, sngBullPos As Single
 Dim lMax As Byte, lCurr As Byte, I As Byte

 If vTabLVL(2) <> cTabWidthPTS Then SetTabLVLs

 sLtpName = "LT " & aStyleName
 sNextPara = aStyleName
 sFile = cBullPath & aBullFileStart
 sngBullPos = (((vTabLVL(2) - cSpcBullParaPTS - vTabLVL(1)) _
              - aBullWidth) / 2) + vTabLVL(1)
 lMax = UBound(aBullFileEnds)

 On Error Resume Next
 Set STY = ActiveDocument.Styles(aStyleName)
 On Error GoTo 0
 If STY Is Nothing Then Set STY = _
                        ActiveDocument.Styles.Add(aStyleName, 1)

 On Error Resume Next
 Set LTP = STY.ListTemplate
 On Error GoTo 0
 If LTP Is Nothing Then
   ListGalleries(wdOutlineNumberGallery).Reset aGalleryNum
   Set LTP = _
     ListGalleries(wdOutlineNumberGallery).ListTemplates(aGalleryNum)
 End If

 With STY
   .LanguageID = wdEnglishUS
   .AutomaticallyUpdate = False: .NoProofing = 0: .Hidden = False
   .NoSpaceBetweenParagraphsOfSameStyle = False

   .BaseStyle = sBaseStyle
   .NextParagraphStyle = sNextPara

   If aBorderColor = -1 Then
     .Borders.Enable = False

   Else
     With .Borders
       .DistanceFromBottom = 1
       .DistanceFromLeft = 4
       .DistanceFromRight = 4
       .DistanceFromTop = 1
       .Shadow = False

       For I = 1 To 4
         With .Item(I)
           .Visible = True
           .Color = aBorderColor
           .LineStyle = wdLineStyleSingle
           .LineWidth = wdLineWidth075pt
         End With
       Next I
       .Item(5).Visible = False
     End With ' .Borders
   End If

   With .Font
     .AllCaps = 0: .Animation = 0: .DoubleStrikeThrough = 0
     .Hidden = 0
     .Name = "Tahoma": .Position = 0: .Scaling = 100: .Shadow = 0
     .SmallCaps = 0: .StrikeThrough = 0
     .Subscript = 0: .Superscript = 0

     .Outline = 0
     .Size = 10
     .Color = wdColorAutomatic

     .Bold = 0
     .Italic = 0
     .Underline = 0
     .UnderlineColor = wdColorAutomatic

     .Spacing = 0
     .Kerning = 0
   End With ' .Font

   With .ParagraphFormat
     .AutoAdjustRightIndent = -1
     .BaseLineAlignment = wdBaselineAlignAuto
     .CharacterUnitFirstLineIndent = 0: .CharacterUnitLeftIndent = 0
     .CharacterUnitRightIndent = 0: .DisableLineHeightGrid = 0
     .HalfWidthPunctuationOnTopOfLine = 0: .HangingPunctuation = -1
     .Hyphenation = -1: .LineUnitAfter = 0: .LineUnitBefore = 0
     .NoLineNumber = 0: .ReadingOrder = 1
     .WidowControl = -1: .WordWrap = -1
     .SpaceBeforeAuto = 0: .SpaceAfterAuto = 0

     .Alignment = wdAlignParagraphLeft
     .OutlineLevel = wdOutlineLevelBodyText

     .FirstLineIndent = -(vTabLVL(2) - sngBullPos)
     .LeftIndent = vTabLVL(2)
     .RightIndent = 0

     .KeepTogether = 0
     .KeepWithNext = 0
     .PageBreakBefore = 0

     .LineSpacingRule = wdLineSpaceExactly
     .LineSpacing = 12

     .SpaceAfter = aSpaceBefAft
     .SpaceBefore = aSpaceBefAft

     With .TabStops
       .ClearAll
       .Add vTabLVL(2), wdAlignTabLeft, wdTabLeaderSpaces
     End With ' .TabStops
   End With ' .ParagraphFormat

   With .Shading
     .BackgroundPatternColor = wdColorAutomatic
     .ForegroundPatternColor = wdColorAutomatic
     .Texture = wdTextureNone
   End With ' .Shading

   .Frame.Delete

   With LTP
     I = 1: lCurr = 0
     x_LstLvlPctBullNew .ListLevels(I), aStyleName, vTabLVL(I + 1), _
                        vTabLVL(I), aBullWidth, aBullFontSize, _
                        sFile & aBullFileEnds(lCurr), aBasePos
     For I = 2 To 9
       lCurr = lCurr + 1
       If lCurr > lMax Then lCurr = 0
       x_LstLvlPctBullNew .ListLevels(I), "", vTabLVL(I + 1), _
                          vTabLVL(I), _
                          aBullWidth, aBullFontSize, _
                          sFile & aBullFileEnds(lCurr), aBasePos
     Next I

     If .Name = "" Then .Name = sLtpName
   End With ' LTP

   If .ListTemplate Is Nothing Then .LinkToListTemplate LTP, 1
 End With ' STY
End Sub

Private Sub x_LstLvlPctBullNew(aLLVL As ListLevel, _
 aLnkStyle As String, _
 aParaPosPTS As Single, aPrevParaPosPTS As Single, _
 aBullWidthPTS As Single, _
 aFontSizePTS As Single, aPictFile As String, _
 Optional aBasePosPTS As Long = 0)
 Dim sngBullPosPTS As Single
 sngBullPosPTS = (((aParaPosPTS - cSpcBullParaPTS _
                 - aPrevParaPosPTS) _
                 - aBullWidthPTS) / 2) + aPrevParaPosPTS

 With aLLVL
   .Alignment = 0: .NumberFormat = ChrW(61623)
   .NumberStyle = wdListNumberStylePictureBullet
   .ResetOnHigher = 0: .StartAt = 1: .TrailingCharacter = 0

   .NumberPosition = sngBullPosPTS
   .TabPosition = aParaPosPTS
   .TextPosition = .TabPosition

   .LinkedStyle = aLnkStyle

   With .Font
     .AllCaps = wdUndefined: .Animation = wdUndefined
     .DoubleStrikeThrough = wdUndefined: .Hidden = wdUndefined
     .Name = "Symbol": .Bold = wdUndefined: .Color = wdColorAutomatic
     .Italic = wdUndefined: .Kerning = wdUndefined
     .Outline = wdUndefined
     .Scaling = wdUndefined: .Shadow = wdUndefined
     .SmallCaps = wdUndefined
     .Spacing = wdUndefined: .StrikeThrough = wdUndefined
     .Subscript = wdUndefined: .Superscript = wdUndefined
     .Underline = wdUndefined: .UnderlineColor = wdUndefined

     .Size = aFontSizePTS
     .Position = aBasePosPTS
   End With ' .Font

   .ApplyPictureBullet aPictFile
 End With ' aLLVL
End Sub
- - - - - - - - - - - -

J Whales