Word VBA for creating bulleted lists

I created a process that send data from excel to word using labels/find&replace. I would just sent the list from excel to word, but the formatting gets wiped out for most text.

As a workaround I wrote code in Word to bold text that falls within <b>these tags</b>. But now I need a good way to use some sort of delineation that will created a list of bullets from content (within Word).

For instance if this text shows in Word, I would like it to be converted into a bulletted list.

<li>Item 1</li>
<li>Item 2</li>
<li>Item 3</li>

I tried searching but did not find any good solutions.

This is the only place I posted this question (I am 120% certain of that).

This would convert your text above to a bulleted list:

Code:

---

    Dim myPara As Paragraph
    Dim myRng As Range
    For Each myPara In ActiveDocument.Paragraphs
        If myPara.Range Like "<li>*</li>" & Chr(13) Then
            myPara.Range.Select
            Do While Selection Like "<li>*</li>" & Chr(13)
                Selection.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
            Loop
            Selection.End = Selection.End - 1 'Drops the last empty paragraph
            Exit For
        End If
    Next
   
    Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
        ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
        False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
        wdWord10ListBehavior


---

Quote:

---

Originally Posted by Mavila

This would convert your text above to a bulleted list:

Code:

---

    Dim myPara As Paragraph
    Dim myRng As Range
    For Each myPara In ActiveDocument.Paragraphs
        If myPara.Range Like "<li>*</li>" & Chr(13) Then
            myPara.Range.Select
            Do While Selection Like "<li>*</li>" & Chr(13)
                Selection.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
            Loop
            Selection.End = Selection.End - 1 'Drops the last empty paragraph
            Exit For
        End If
    Next
   
    Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
        ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
        False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
        wdWord10ListBehavior


---

---

Mavila,

Thank you so much for the reply. It works, but with some bugs. Check the images below for a before and after.

BEFORE macro
Attachment 25662
AFTER macro
Attachment 25663

The following will work.

Code:

---

Dim oRng As Range   
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="</li>^11", MatchWildcards:=False)
            oRng.Text = "</li>" & vbCr
            oRng.Collapse 0
            DoEvents
        Loop
    End With
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="\<li\>*\</li\>", MatchWildcards:=True)
            oRng.Text = Replace(oRng.Text, "</li>", "")
            oRng.Style = "List Bullet"
            oRng.Collapse 0
            DoEvents
        Loop
    End With
    Set oRng = Nothing

---

Better still:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Replacement.Style = "List Bullet"
  .Text = "\<li\>(*)\</li\>^13"
  .Replacement.Text = "\1^p"
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

---