Word VBA for creating bulleted lists

[noslenwerd]

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).

[Mavila]

This would convert your text above to a bulleted list:



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

[noslenwerd]

This would convert your text above to a bulleted list:



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
25662
AFTER macro
25663

[gmayor]

The following will work.

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

[macropod]

Better still:

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