1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

Reiniciar lista numerada VBA Excel Word

Discussion in 'Technology' started by Oathbreaker, Oct 8, 2018.

  1. Oathbreaker

    Oathbreaker Guest

    Estou a tentar criar uma macro em VBA para criar um documento de word a partir do Excel.

    De momento estou a ter problemas com as listas.

    Eu quero que a numeração das listas esteja ligado aos meus Estilos Header1 e Header2 de modo a ficarem assim:

    1. Header1
    1.1. Header2
    2. Header1
    2.1 Header2


    O problema é que o nível 2 da lista não está a resetar mesmo quando utilizo a propriedade .ResetOnHigher

    Isto significa que o resultado que obtenho se parece mais com:

    1. Header1
    1.1. Header2
    2. Header1
    1.2 Header2


    Não sei se estou a fazer alguma coisa de errado ou se me falta algum pedaço de código aqui fica um excerto do código que estou a utilizar.

    (...)

    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

    (...)

    Login To add answer/comment
     

Share This Page