(Long) Disappearing picture bullet

[jwhales]

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

 

[Margaret Aldis]

I haven't tried to follow your code, but before you go any further have you
tried doing a Ctrl-Q on the paragraphs that are in the style but not showing
the picture bullet?

Word sometimes reapplies list formatting as direct formatting, even when it
comes from the style (seems to a particular problem with copy and paste).
Then if the style changes it won't be seen by these paragraphs. Copy and
paste in Word 2002 was noted for "cancelling out" list formatting too -
take say a List Bullet para from one document, paste it into another with
the same styles, and sometimes the bullet disappears!

 

[jwhales]

Thanks for your reply.

The missing picture bullets are 'invisible' both in the document and in
the "Styles and Formatting" task pane. There is no copy/paste involved
in the document since it is a brand new template that I made with no
fiddling by anyone else.

So, the Ctrl-Q unfortunatly didn't work...

J Whales

 

[J Whales]

Quick message to let you know that I've also posted this question in
microsoft.public.word.vba.general because this newsgroup seems to have a
rather low volume...

J Whales

 

[Klaus Linke]

Hi J,

Your sample code is a bit long, so people likely don't want to spend a lot of time figuring it out ;-)

You seem to create one style "Action Gz", define a list template with 9 levels, and link "Action Gz" to the first level.
The list template has two picture bullets, alternating.

First, a question: Do you really need one style with two different bullets and nine different indents?
Usually you'd use two styles with the two picture bullets. And you wouldn't use the same list template for them unless they are really meant as an outline.
If not, you'd not need to worry about list templates at all.
Perhaps a simpler setup won't run into problems.

After a bit of fiddling, I've seen the same probem as you: The style shows the picture bullet in the "Styles and formatting" toolbar, but a regular bullet in the document.
I haven't figured out yet what goes wrong. Probably it's a bug in Word rather than a problem with your code. If you find some simple steps that reproducibly create the problem, you should report it to Microsoft. I'll try to do that, too, but don't have too much time to experiment.

One tip regarding your code: Best avoid the ListGallery. Create a new list template instead:
Set LTP = ActiveDocument.ListTemplates("ActionLT")
(and on subsequent runs, check if the named list template "ActionLT" already exists).
That's simpler and less likely to cause problems (say, because the list template in the list gallery that you are modifying is already linked to some styles).

Regards,
Klaus

 

[J Whales]

Hi Klaus (and other readers),

I did thought that this long code would throw off most people...

But I seem to have found the solution! And after about 2 months of
scratching my head (now my scalp - no more hairs...) it's not too
soon...

I didn't pinpoint the exact source of the problem, but it went away
after I did 3 things:

1- Remove everything in the
"HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Word\List Gallery
Presets" registry key;

2- Create a new 'blank' template that I use as the basis for the
template into which I create the styles. (Deleted Normal.dot, started
Word - on exit a new, 'clean' Normal.dot is created)

3- Cleanup the 'StyleBuilder' template that contains the code that
generates the styles;

I suspect that my 'StyleBuilder' template was the one having the
problem... Somehow I didn't use a 'blank' template to create it, and I
guess some junk in it was interfering.

Anyway, everything seems to be fine (crossing fingers, touching wood,
rubbing a Boudha's belly...) for now.

Thanks to everyone that tried to help!

J Whales

Hi J,

Your sample code is a bit long, so people likely don't want to spend

a lot of time figuring it out ;-)

You seem to create one style "Action Gz", define a list template with

9 levels, and link "Action Gz" to the first level.

The list template has two picture bullets, alternating.

First, a question: Do you really need one style with two different

bullets and nine different indents?

Usually you'd use two styles with the two picture bullets. And you

wouldn't use the same list template for them unless they are really
meant as an outline.

If not, you'd not need to worry about list templates at all.
Perhaps a simpler setup won't run into problems.

After a bit of fiddling, I've seen the same probem as you: The style

shows the picture bullet in the "Styles and formatting" toolbar, but a
regular bullet in the document.

I haven't figured out yet what goes wrong. Probably it's a bug in

Word rather than a problem with your code. If you find some simple
steps that reproducibly create the problem, you should report it to
Microsoft. I'll try to do that, too, but don't have too much time to
experiment.

One tip regarding your code: Best avoid the ListGallery. Create a new list template instead:
Set LTP = ActiveDocument.ListTemplates("ActionLT")
(and on subsequent runs, check if the named list template "ActionLT" already exists).
That's simpler and less likely to cause problems (say, because the

list template in the list gallery that you are modifying is already
linked to some styles).