Search code examples
vbaexcelms-wordoffice-2007

Excel VBA for creating numbered list in Word


I am trying to use VBA code in Excel to create a numbered list in a Word document.

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add

With wrdDoc
    For i = 0 To 5
        .Content.InsertAfter ("Paragraph " & i)
        .Content.InsertParagraphAfter
    Next

    .Paragraphs(1).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
        ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
        False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
        wdWord10ListBehavior
End With

Set wrdApp = Nothing
Set wrdDoc = Nothing

When I run this I get an error:

Method 'ApplyListTemplateWithLevel' of object 'ListFormat' failed

I have checked the Microsoft Word 12.0 Object Library in the Excel VBA references list.


Solution

  • Ok I found the problem. I remoted into a friends machine to check. I got the same error as you if there were other word documents open. If no other word documents are open then your code just works fine.

    Try this code. It latebinds with the Word Application so you don't need a reference to be added.

    Sub Sample()
        Dim oWordApp As Object, oWordDoc As Object
    
        '~~> Establish an Word application object
        On Error Resume Next
        Set oWordApp = GetObject(, "Word.Application")
    
        If Err.Number <> 0 Then
            Set oWordApp = CreateObject("Word.Application")
        End If
        Err.Clear
        On Error GoTo 0
    
        oWordApp.Visible = True
    
        Set oWordDoc = oWordApp.Documents.Add
    
        With oWordDoc
            For i = 0 To 5
                .Content.InsertAfter ("Paragraph " & i)
                .Content.InsertParagraphAfter
            Next
    
            DoEvents
    
            .Paragraphs(1).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
            False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
            wdWord10ListBehavior
        End With
    
        Set oWordApp = Nothing
        Set oWordDoc = Nothing
    End Sub