Restart Numbered VBA Excel Word List

Asked

Viewed 357 times

3

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

Right now I’m having trouble 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 property. Resetonhigher

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 anything 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

(...)
excel vba

2 answers

1

Try to store the last header in a variable and at the time of using the command .ResetOnHigher match with the variable

Ex:

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

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

    .ResetOnHigher = variavel

end With

-1

'formato de encabezado.
objWord.Selection.Style = ("Heading 1")

'Crear pasos para dar numeración a titulo 1.1.

With objWord.ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = "%1.%2"
End With          
    End With
    .LinkedStyle = "Heading 2"
    End With

Browser other questions tagged excel vba

You are not signed in. Login or sign up in order to post.