使用文本样式VBA宏MS Word重置编号列表

时间:2014-10-08 21:44:27

标签: excel vba ms-word

我试图制作一个VBA宏来从excel创建一个word文档... 目前我在正确设置列表时遇到问题。我希望列表索引链接到我的2个标头类型。 像这样:

1. Header1
 1.1. Header2
2. Header1
 2.1 Header2

问题是我的2级列表没有重置,即使我已经包含.ResetOnHigher属性。这意味着我得到的结果如下:

1. Header1
 1.1. Header2
2. Header1
 1.2 Header2

有人可以告诉我我做错了什么,我该怎么做才能解决这个问题?

以下是我使用的代码的一部分:

(...)

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

(...)

1 个答案:

答案 0 :(得分:0)

我有完全相同的问题,我花了一整天的时间来解决它。事情是你正在创建样式,并在每个样式中指向List + Listlevel。当您使用这些样式时,每个样式都会创建自己的列表。所以解决方案是反过来做。

您必须使用所有ist listlevels创建新的List模板,并且在每个Listlevel中,您必须指向样式,如:

  

ActiveDocument.ListTemplates(“LT”)。ListLevels(1).LinkedStyle =“Style1”

如果您想使用此特定格式,请通过以下方式插入:

  

.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= ActiveDocument.ListTemplates(“LT”),ContinuePreviousList:= True,ApplyLevel:= 1

玩得开心=)

相关问题