Excel VBA для создания нумерованного списка в Word

Question

Я пытаюсь использовать код VBA в Excel для создания нумерованного списка в документе Word.

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 

Когда я запускаю это я получаю сообщение об ошибке:

Method 'ApplyListTemplateWithLevel' of object 'ListFormat' failed

Я проверил Microsoft Word 12.0 Object Library в списке Excel VBA ссылки.

Answer 1

Хорошо, я нашел проблему. Я удалился в машину друзей, чтобы проверить. Я получил ту же ошибку, что и вы, если были открыты другие текстовые документы. Если никакие другие текстовые документы не открыты, ваш код просто отлично работает.

Попробуйте этот код. Он задерживается приложением Word, поэтому вам не нужна ссылка для добавления.

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