(Long) Disappearing picture bullet

[J Whales]

(I posted this a couple of days ago in microsoft.public.word.numbering,
but I just realised that the traffic over there is rather low...
So I'm trying again here, with a little more details.)

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! In the VBA watch window, I can see that the
style's list levels still contains the PictureBullet object, but it is
not displayed.

If I reopen the template WITHOUT closing Word, the picture bullets are
still there. They dissapear when Word is completely closed.

The picture bullets are not seen both in the document and in the
"Styles and Formatting" task pane so it's not a problem that can be
fixed with Ctrl-Q.

I copied the code used below (I did my best to prevent unsightly line
wraps). I'm working in Word 2003 SP1 on Windows XP SP2. The images I
use for my picture bullets are small .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(sStyleNa­me)
On Error GoTo 0
If STY Is Nothing Then Set STY = _
ActiveDocument.Styles.Add(sSty­leName, 1)

With STY
.LanguageID = wdEnglishUS
.AutomaticallyUpdate = False: .NoProofing = 0: .Hidden = False
.NoSpaceBetweenParagraphsOfSam­eStyle = 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
.HalfWidthPunctuationOnTopOfLi­ne = 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(aStyleNa­me)
On Error GoTo 0
If STY Is Nothing Then Set STY = _
ActiveDocument.Styles.Add(aSty­leName, 1)

On Error Resume Next
Set LTP = STY.ListTemplate
On Error GoTo 0
If LTP Is Nothing Then
ListGalleries(wdOutlineNumberG­allery).Reset aGalleryNum
Set LTP = _

ListGalleries(wdOutlineNumberG­allery).ListTemplates(aGallery­Num)
End If

With STY
.LanguageID = wdEnglishUS
.AutomaticallyUpdate = False: .NoProofing = 0: .Hidden = False
.NoSpaceBetweenParagraphsOfSam­eStyle = 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
.HalfWidthPunctuationOnTopOfLi­ne = 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