Word VBA：多级编号的设置

守候_CJ

一、需要达到的效果

• 文档中样式“标题 1”到“标题 9”分别链接到相应级别列表
• 各级列表与文字间不用默认的制表符连接，而用空格连接
• 完成对激活文档（当前文档）光标所选区域符合要求的标题段落（样式为“标题 n”的段落）应用此列表
  

多级列表目标效果

二、代码

1. Sub 多级列表()
   
2.     Dim numFormatStr As String
   
3.     Dim i As Byte
   
4.     Dim doc As Document
   
5.     Dim listTemp As Word.ListTemplate
   
6.    
   
7.     Set doc = ActiveDocument
   
8.     Set listTemp = Word.Application.ListGalleries(wdOutlineNumberGallery).ListTemplates(1)
   
9.    
   
10.     For i = 1 To 9
    
11.         numFormatStr = numFormatStr & ".%" & i
    
12.         If Left(numFormatStr, 1) = "." Then
    
13.             numFormatStr = Mid(numFormatStr, 2)
    
14.         End If
    
15.         
    
16.         With listTemp.ListLevels(i)
    
17.             .NumberFormat = numFormatStr
    
18.             .TrailingCharacter = Word.WdTrailingCharacter.wdTrailingSpace
    
19.             .NumberStyle = Word.WdListNumberStyle.wdListNumberStyleArabic
    
20.             .NumberPosition = CentimetersToPoints(0)
    
21.             .Alignment = Word.WdListLevelAlignment.wdListLevelAlignLeft
    
22.             .TextPosition = CentimetersToPoints(0)
    
23.             .ResetOnHigher = i - 1
    
24.             .StartAt = 1
    
25.             .LinkedStyle = "标题 " & i
    
26.             With .Font
    
27.                 .name = doc.Styles("标题 " & i).Font.name
    
28.                 .NameFarEast = doc.Styles("标题 " & i).Font.NameFarEast
    
29.                 .Size = doc.Styles("标题 " & i).Font.Size
    
30.                 .Bold = doc.Styles("标题 " & i).Font.Bold
    
31.                 .Italic = doc.Styles("标题 " & i).Font.Italic
    
32.             End With
    
33.         End With
    
34.     Next
    
35.    
    
36.     For Each pa In Selection.Paragraphs
    
37.         If pa.Style.NameLocal Like "标题 #" Then
    
38.             pa.Range.ListFormat.ApplyListTemplateWithLevel _
    
39.                 ListTemplate:=listTemp, _
    
40.                 ContinuePreviousList:=True, _
    
41.                 ApplyTo:=wdListApplyToWholeList, _
    
42.                 DefaultListBehavior:=wdWord10ListBehavior
    
43.         End If
    
44.     Next
    
45.    
    
46.     Set doc = Nothing
    
47.     Set listTemp = Nothing
    
48. End Sub

复制代码