Restart numbered list VBA Excel Word

Question:

I'm trying to create a macro in VBA to create a word document from Excel.

I'm currently having problems with the lists.

I want the list numbering to be linked to my Header1 and Header2 Styles so they look like this:

1. Header1
  1.1. Header2
2. Header1
  2.1 Header2

The problem is that level 2 of the list is not resetting even when I use the .ResetOnHigher property

This means that the result I get looks more like:

1. Header1
  1.1. Header2
2. Header1
  1.2 Header2

I don't know if I'm doing something wrong or if I'm missing a piece of code here is an excerpt of the code I'm using.

(...)

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = "%1."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(0.63)
    .TabPosition = wdUndefined
    .StartAt = 1
End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)
    .NumberFormat = "%1.%2."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0.63)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(1.4)
    .TabPosition = wdUndefined
    .ResetOnHigher = 1
    .StartAt = 1
End With

    With myDoc
    'Heading 1
        .Styles(wdStyleHeading1).Font.Name = "Arial"
        .Styles(wdStyleHeading1).Font.Size = 24
        .Styles(wdStyleHeading1).Font.Color = wdColorBlack
        .Styles(wdStyleHeading1).Font.Bold = True
        .Styles(wdStyleHeading1).ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        .Styles(wdStyleHeading1).ParagraphFormat.SpaceAfter = 12
        .Styles(wdStyleHeading1).LinkToListTemplate _
            ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
            ListLevelNumber:=1

    'Heading 2
        .Styles(wdStyleHeading2).Font.Name = "Arial"
        .Styles(wdStyleHeading2).Font.Size = 18
        .Styles(wdStyleHeading2).Font.Color = wdColorBlack
        .Styles(wdStyleHeading2).Font.Bold = True
        .Styles(wdStyleHeading2).ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        .Styles(wdStyleHeading2).ParagraphFormat.SpaceAfter = 12
        .Styles(wdStyleHeading2).LinkToListTemplate _
            ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
            ListLevelNumber:=2
End With

(...)

'Loop through sheets
For I = 2 To WS_Count - 1

'Check if sheet is to be included and if so past its content to word
If ThisWorkbook.Worksheets(I).Shapes("Enable").OLEFormat.Object.Value = 1 = True Then

    'Insert Group Title if Group is different
    If ThisWorkbook.Worksheets(I).Cells(1, 1).Value = ThisWorkbook.Worksheets(I - 1).Cells(1, 1).Value = False Then

        myDoc.Paragraphs.Last.Range.Style = myDoc.Styles("Heading 1")
        myDoc.Paragraphs.Last.Range.Text = ThisWorkbook.Worksheets(I).Range("A1")
        myDoc.Paragraphs.Last.Range.InsertParagraphAfter

    End If

    'Insert Page Title
    myDoc.Paragraphs.Last.Range.Style = myDoc.Styles("Heading 2")
    myDoc.Paragraphs.Last.Range.Text = ThisWorkbook.Worksheets(I).Range("A2")
    myDoc.Paragraphs.Last.Range.InsertParagraphAfter

    'Insert Tables
    Call ExcelRangeToWord(myDoc, ThisWorkbook.Worksheets(I).Range("range1"), 1)
    myDoc.Paragraphs.Last.Range.InsertParagraph
    Call ExcelRangeToWord(myDoc, ThisWorkbook.Worksheets(I).Range("range2"), 2)
    myDoc.Paragraphs.Last.Range.InsertParagraph

    'Insert Page Break on last paragraph
    myDoc.Paragraphs.Last.Range.InsertBreak (wdPageBreak)

End If

(...)

Answer:

Try to store the last header in a variable and when using the .ResetOnHigher command match it with the variable

Ex:

Dim variavel as long
variavel = ultimoHeader.value(exemplo)

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)

    .ResetOnHigher = variavel

end With
Scroll to Top