Thread: [Solved] Bulletted List Creation
View Single Post
 
Old 11-10-2013, 12:05 AM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,374
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hard-formatting (i.e. overriding whatever Style is already applied to the content) is poor practice; it can lead to inconsistencies, makes the document harder to manage and introduce corruption.

The absence of the required styles in the target documents is easily-enough handled:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Stl As Style, bBulletA As Boolean, bBulletB As Boolean, Rng As Range
bBulletA = False: bBulletB = False
For Each Stl In ActiveDocument.Styles
  If Stl.NameLocal = "BulletA" Then bBulletA = True
  If Stl.NameLocal = "BulletB" Then bBulletB = True
Next
If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(&H25CF))
If bBulletB = False Then Call AddBulletStyle("BulletB", "o")
Set Rng = ActiveDocument.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Met[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Start = .Start + 1
    .End = .End - 1
    .Style = "BulletA"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Start = Rng.Start
  .End = Rng.End
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Exceeded[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Start = .Start + 1
    .End = .End - 1
    .Style = "BulletB"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
 
Private Sub AddBulletStyle(StrNm As String, StrBullet As String)
Dim Stl As Style
Set Stl = ActiveDocument.Styles.Add(Name:=StrNm, _
  Type:=wdStyleTypeParagraph)
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
  .NumberFormat = StrBullet
  .TrailingCharacter = wdTrailingTab
  .NumberStyle = wdListNumberStyleBullet
  .NumberPosition = InchesToPoints(0)
  .Alignment = wdListLevelAlignLeft
  .TextPosition = InchesToPoints(1)
  .TabPosition = InchesToPoints(1)
  .ResetOnHigher = 0
  .StartAt = 1
  .LinkedStyle = StrNm
End With
With Stl
  .AutomaticallyUpdate = False
  .BaseStyle = "Normal"
  .LinkToListTemplate _
    ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
    ListLevelNumber:=1
  With .ParagraphFormat
    .LeftIndent = InchesToPoints(1)
    .RightIndent = InchesToPoints(0)
    .FirstLineIndent = InchesToPoints(-1)
    .TabStops.ClearAll
    .TabStops.Add Position:=InchesToPoints(1), _
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  End With
End With
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Last edited by macropod; 11-10-2013 at 12:08 AM. Reason: Code revision
Reply With Quote