一、需要达到的效果

文档中样式“标题 1”到“标题 9”分别链接到相应级别列表

各级列表与文字间不用默认的制表符连接，而用空格连接

完成对激活文档（当前文档）光标所选区域符合要求的标题段落（样式为“标题 n”的段落）应用此列表

多级列表目标效果

二、代码

Sub 多级列表()

Dim numFormatStr As String

Dim i As Byte

Dim doc As Document

Dim listTemp As Word.ListTemplate

Set doc = ActiveDocument

Set listTemp = Word.Application.ListGalleries(wdOutlineNumberGallery).ListTemplates(1)

For i = 1 To 9

numFormatStr = numFormatStr & ".%" & i

If Left(numFormatStr, 1) = "." Then

numFormatStr = Mid(numFormatStr, 2)

End If

With listTemp.ListLevels(i)

.NumberFormat = numFormatStr

.TrailingCharacter = Word.WdTrailingCharacter.wdTrailingSpace

.NumberStyle = Word.WdListNumberStyle.wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = Word.WdListLevelAlignment.wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(0)

.ResetOnHigher = i - 1

.StartAt = 1

.LinkedStyle = "标题 " & i

With .Font

.name = doc.Styles("标题 " & i).Font.name

.NameFarEast = doc.Styles("标题 " & i).Font.NameFarEast

.Size = doc.Styles("标题 " & i).Font.Size

.Bold = doc.Styles("标题 " & i).Font.Bold

.Italic = doc.Styles("标题 " & i).Font.Italic

End With

End With

Next

For Each pa In Selection.Paragraphs

If pa.Style.NameLocal Like "标题 #" Then

pa.Range.ListFormat.ApplyListTemplateWithLevel _

ListTemplate:=listTemp, _

ContinuePreviousList:=True, _

ApplyTo:=wdListApplyToWholeList, _

DefaultListBehavior:=wdWord10ListBehavior

End If

Next

Set doc = Nothing

Set listTemp = Nothing

End Sub