Thread: [Solved] Bulletted List Creation
View Single Post
 
Old 11-17-2013, 05:29 PM
macropod's Avatar
macropod macropod is offline 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

Ho hum, try:
Code:
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
  ' Apply the "BulletA" Style to the whole document
  .Style = "BulletA"
  ' Apply the "Normal" Style to the first paragraph
  .Paragraphs.First.Style = "Normal"
  ' Apply the "Strong" Character Style to the first paragraph
  .Paragraphs.First.Range.Style = "Strong"
  ' Find paragraphs containing a comma"
  With .Find
    .Text = ",[!^13,]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  ' For each found paragraph
  Do While .Find.Found
    ' Move the start of our range forward one character,
    ' to start the new format after the comma and
    ' because the Find expression includes the comma
    ' from the previous iteration
    .Start = .Start + 1
    ' Apply the "Strong" Character Style from the last comma
    .Style = "Strong"
    ' Collapse the Find range to its end
    .Collapse wdCollapseEnd
    ' Look for the next instance
    .Find.Execute
  Loop
  ' Re-set the Find range
  .Start = wdRng.Start
  .End = wdRng.End
  ' Look for paragraphs starting with "Exceeded"
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Exceeded[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  ' For each found paragraph
  Do While .Find.Found
    ' Move the start of our range forward one character,
    ' because the Find expression includes the paragraph
    ' break from the previous paragraph
    .Start = .Start + 1
    ' Move the end of our range backwards one character,
    ' because the next Find expression includes the paragraph
    ' break from this paragraph
    .End = .End - 1
    ' Clear the "Strong" Character Style if it's been set
    .Font.Reset
    ' Apply the "BulletA" Style to the paragraph
    .Style = "BulletB"
    ' Apply the "Emphasis" Style to the first two words in the paragraph
    With .Paragraphs.First.Range.Words.First
      .Style = "Emphasis"
      .Next.Words.First.Style = "Emphasis"
    End With
    ' Collapse the Find range to its end
    .Collapse wdCollapseEnd
    ' Look for the next instance
    .Find.Execute
  Loop
End With
wdApp.WindowState = wdWindowStateNormal
Set wdApp = Nothing: Set wdDoc = Nothing: Set wdRng = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote