Thread: [Solved] Bulletted List Creation
View Single Post
 
Old 11-12-2013, 12:21 AM
macropod's Avatar
macropod macropod is online now Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
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

Try all of the following in the same code module:
Code:
Option Explicit
' Define Word variables
Dim wdApp As Word.Application, wdDoc As Word.Document, wdStl As Word.Style
 
Sub MyCode()
Dim a As Range, b As Range, i As Long, t As Long, bBulletA As Boolean, bBulletB As Boolean
bBulletA = False: bBulletB = False
Application.ScreenUpdating = False
t = Worksheets(1).Range("A3:A10000").SpecialCells(xlCellTypeConstants).Cells.Count
Set a = Worksheets(1).Range("A5").Cells
Set b = Worksheets(1).Range("B5").Cells
Set wdApp = New Word.Application
wdApp.Visible = True
wdApp.WindowState = wdWindowStateMinimize
Set wdDoc = wdApp.Documents.Add
With wdDoc.Range
  .InsertAfter "Drafted" & " Something" & vbCr
  For i = 1 To t
    .InsertAfter a.Value & vbCr & b.Value & vbCr
    Set a = a.Offset(1, 0).Cells
    Set b = b.Offset(1, 0).Cells
  Next i
End With
For Each wdStl In wdDoc.Styles
  If wdStl.NameLocal = "BulletA" Then bBulletA = True
  If wdStl.NameLocal = "BulletB" Then bBulletB = True
Next
If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(61623), _
  wdApp.InchesToPoints(0), wdApp.InchesToPoints(0.5), True)
If bBulletB = False Then Call AddBulletStyle("BulletB", "o", _
  wdApp.InchesToPoints(1), wdApp.InchesToPoints(1.5), False)
With wdDoc.Range
  .Style = "BulletA"
  .Paragraphs.First.Style = "Normal"
  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
wdApp.WindowState = wdWindowStateNormal
Set wdApp = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub 
 
Sub AddBulletStyle(StrNm As String, StrBullet As String, iIndnt As Single, iHang As Single, bFntBld As Boolean)
Set wdStl = wdDoc.Styles.Add(Name:=StrNm, Type:=wdStyleTypeParagraph)
With wdApp.ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
  .NumberFormat = StrBullet
  .TrailingCharacter = wdTrailingTab
  .NumberStyle = wdListNumberStyleBullet
  .NumberPosition = wdApp.InchesToPoints(0)
  .Alignment = wdListLevelAlignLeft
  .ResetOnHigher = 0
  .StartAt = 1
  .LinkedStyle = StrNm
End With
With wdStl
  .AutomaticallyUpdate = False
  .BaseStyle = "Normal"
  .LinkToListTemplate ListTemplate:=wdApp.ListGalleries(wdBulletGallery).ListTemplates(1), ListLevelNumber:=1
  With .ParagraphFormat
    .LeftIndent = iHang
    .RightIndent = wdApp.InchesToPoints(0)
    .FirstLineIndent = -iHang + iIndnt
    .TabStops.ClearAll
    .TabStops.Add Position:=iHang, _
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  End With
  .Font.Bold = bFntBld
End With
End Sub
Note the extent of the explicit referencing to Word & wdApp.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote