Word ListGalleries ListTemplates in Excel VBA

[tinfanide]

Sub test()
 
Dim wrdApp As Word.Application
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Dim wrdDoc As Word.Document
Set wrdDoc = wrdApp.Documents.Add
 
Dim wrdTbl As Word.Table
Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, NumRows:=6, NumColumns:=1)
 
With wrdTbl
 
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderRight).LineStyle = wdLineStyleSingle
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
.Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
 
For r = 1 To 6
    .Cell(r, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
Next r
End With
 
' Dim temp3 As ListGalleries
For r = 1 To 6 Step 2
Set temp3 = wrdApp.ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
With temp3
    .NumberFormat = "%1."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0.63)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(1.27)
    .TabPosition = wdUndefined
    .StartAt = r
End With
Dim rng As Range
Set rng = wrdDoc.Range(Start:=wrdDoc.Range.Rows(1).Range.Start, End:=wrdDoc.Range.Rows(6).Range.End)
rng.ListFormat.ApplyListTemplate ListTemplate:=temp3
Next r
 
End Sub

The above codes work well in Word VBA but not in Excel.
Don't know why so difficult to use ListGalleries in Excel to control Word...
Have found millions of entries online but could hardly find one.
Could anyone please help a bit? I'm desperate...
Near nil online coverage on Word VBA...

 

[Andrew Poulsom]

In what way doesn't it work?

 

[tinfanide]

Please take a look at the demo vid. Any help is appreciated.
http://www.youtube.com/watch?v=tVZhav-E92w&feature=youtu.be

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim wrdTbl As Word.Table
    Dim r As Long
    Dim temp3 As Word.ListTemplate
    Dim rng As Word.Range
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add
    Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, NumRows:=6, NumColumns:=1)
    With wrdTbl
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
        .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
        For r = 1 To 6
            .Cell(r, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
        Next r
    End With
    Set temp3 = wrdApp.ListGalleries(wdNumberGallery).ListTemplates(1)
    With temp3.ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = wrdApp.CentimetersToPoints(0.63)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = wrdApp.CentimetersToPoints(1.27)
        .TabPosition = wdUndefined
        .StartAt = 1
    End With
    Set rng = wrdDoc.Tables(1).Range
    rng.ListFormat.ApplyListTemplate ListTemplate:=temp3
End Sub

 

[tinfanide]

Try:

Sub Test()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim wrdTbl As Word.Table
    Dim r As Long
    Dim temp3 As Word.ListTemplate
    Dim rng As Word.Range
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add
    Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, NumRows:=6, NumColumns:=1)
    With wrdTbl
        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
        .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
        .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
        .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
        .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
        For r = 1 To 6
            .Cell(r, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
        Next r
    End With
    Set temp3 = wrdApp.ListGalleries(wdNumberGallery).ListTemplates(1)
    With temp3.ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = wrdApp.CentimetersToPoints(0.63)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = wrdApp.CentimetersToPoints(1.27)
        .TabPosition = wdUndefined
        .StartAt = 1
    End With
    Set rng = wrdDoc.Tables(1).Range
    rng.ListFormat.ApplyListTemplate ListTemplate:=temp3
End Sub

Thanks for the codes. It hinted me at why my previous codes didn't work as expected. I noticed that it might be caused by these lines:

Set temp3 = wrdApp.ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1) With temp3</pre>