根据预定义段落进行段落样式的设置和插入目录(VBA)

'* +++++++++++++++++++++++++++++++++++++++ '^The Code CopyIn [ThisDocument-ThisDocument]^' '* -------------------------------------------------------------------------- 功能简介：对于网上复制的一些非正规编排的文档，没有大纲级别，也没有很好地 样式格式以区分，利用此功能，可以根据先前的手动目录，更改为自动生成的目录， 便于文档管理。 Sub Contents() Dim I As Paragraph, N As Byte, A As Byte, B As Byte, X As Long, DelRange As Range Application.ScreenUpdating = False A = 2 B = 13 With ActiveDocument For Each I In .Paragraphs '在段落中循环 X = X + 1 '计数 For N = A To B '进入文档第二段落到第十三段落间的循环 If X > B Then If I.Range = .Paragraphs(N).Range Then I.Style = .Styles(wdStyleHeading1) '将 A = A + 1 '累计 End If End If Next Next Set DelRange = Range(.Paragraphs(2).Range.Start, .Paragraphs(13).Range.End) DelRange.Delete '删除原文档的第二~第十三个段落 .Paragraphs(2).Range.Select '插入/引用/索引与目录 .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _ True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _ LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _ UseHyperlinks:=True, HidePageNumbersInWeb:=True .TablesOfContents(1).TabLeader = wdTabLeaderDots .TablesOfContents.Format = wdIndexIndent End With Application.ScreenUpdating = True End Sub