Consulting

Results 1 to 5 of 5

Thread: Word VBA for creating bulleted lists

  1. #1

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

  2. #2
    VBAX Contributor
    Joined
    Aug 2012
    Posts
    103
    Location
    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
    

  3. #3
    Quote Originally Posted by Mavila View Post
    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
    before.JPG
    AFTER macro
    after.JPG

  4. #4
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,962
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •