多级标题自动编号（宏）

413191246se · 发表于 2019-8-18 22:27

本帖最后由 413191246se 于 2019-8-18 22:48 编辑

* 不喜欢折腾样式的朋友们，可以用本宏来给多级标题自动编号，标题级别分 5 级（标题 1~5）。
* 第1级标题只须打“第一章（或第1章）；2/3/4/5级标题，只须打“1.1/1.1.1/1.1.1.1/1.1.1.1.1”。
* 请永远不必打“第二章/第三章”，不需要，只须打“第一章 XX”，“第1章 YY”，本宏会自动编号。
* 第1级标题（第X章）默认左对齐，有参数可以调整为居中；可以“第一章”，也可以“第1章”。
* 各级标题均采用 Word 内置样式（Word2003），格式可根据自己需要自行调整，谢谢大家！

Sub 多级标题自动编号()
'''初始化
With ActiveDocument
'通用模板内置样式复制到活动文档
.CopyStylesFromTemplate Template:=.AttachedTemplate.FullName
'删除所有域
.Fields.Unlink
'列表编号/LISTNUM域转文本
.ConvertNumbersToText
'回车符/手动换行符=>段落标记
.Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
.Select
'清除格式/删除段落首尾空格
With Selection
.ClearFormatting
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
'删除所有空格
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Execute "^w", , , 0, , , , , , "", 2
.Execute "　", , , 0, , , , , , "", 2
End With
'正文样式
With .Font
.Size = 14
.Color = wdColorBlue
End With
.ParagraphFormat.CharacterUnitFirstLineIndent = 2
End With
End With
'''
Const s As String = "一二三四五六七八九十百零〇○OoＯｏ1234567890１２３４５６７８９０"
Dim a&, b&, c&, d&, e&, j&, k&, n&, i As Paragraph
'j=0第一章/j=1=第1章
j = 0
'k=0=左对齐/k=1=居中(标题1)
k = 0
'''Style
With ActiveDocument
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
n = 1
If .Text Like "第*" Then n = 2
Do While InStr(s, .Characters(n)) > 0
n = n + 1
If .Characters(n).Text = "章" Then .Style = wdStyleHeading1: Exit Do
If .Characters(n) Like "[!0-9]" Then
If .Text Like "*.*.*.*.*" Then
.Style = wdStyleHeading5
ElseIf .Text Like "*.*.*.*" Then
.Style = wdStyleHeading4
ElseIf .Text Like "*.*.*" Then
.Style = wdStyleHeading3
ElseIf .Text Like "*.*" Then
.Style = wdStyleHeading2
End If
End If
Loop
End If
End With
Next
'''Color/Indent
With .Styles(wdStyleHeading1)
.Font.Color = wdColorRed
With .ParagraphFormat
.SpaceBefore = 30
.SpaceAfter = 24
If k = 1 Then .Alignment = wdAlignParagraphCenter
End With
End With
With .Styles(wdStyleHeading2)
.Font.Color = wdColorPink
.ParagraphFormat.CharacterUnitFirstLineIndent = 1.75
End With
With .Styles(wdStyleHeading3)
.Font.Color = wdColorGreen
.ParagraphFormat.CharacterUnitFirstLineIndent = 1.75
End With
With .Styles(wdStyleHeading4)
.Font.Color = wdColorBrown
.ParagraphFormat.CharacterUnitFirstLineIndent = 2
End With
With .Styles(wdStyleHeading5)
.Font.Color = wdColorOrange
.ParagraphFormat.CharacterUnitFirstLineIndent = 2
End With
'''AutoNum
.Content.Find.Execute "(^13[0-9.]{1,})", , , 1, , , , , , "\1`", 2
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
If .Style Like "标题*" Then
If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
End If
If .Style = "标题 1" Then
a = a + 1
b = 0
If j = 0 Then
With ActiveDocument.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(.Text, "章")).End - 1)
.Delete
.Fields.Add Range:=i.Range, Text:="= " & a & " \* CHINESENUM3"
.Fields.Unlink
.InsertBefore Text:="第"
End With
ElseIf j = 1 Then
ActiveDocument.Range(Start:=.Characters(2).Start, End:=.Characters(InStr(.Text, "章") - 1).End).Text = a
End If
If .Characters(InStr(.Text, "章") + 3).Text = vbCr Then .Characters.Last.Previous.InsertBefore Text:="　"
.Characters(InStr(.Text, "章")).InsertAfter Text:="　"
ElseIf .Style = "标题 2" Then
b = b + 1
c = 0
ActiveDocument.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(.Text, "`") - 1).End).Text = a & "." & b
ElseIf .Style = "标题 3" Then
c = c + 1
d = 0
ActiveDocument.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(.Text, "`") - 1).End).Text = a & "." & b & "." & c
ElseIf .Style = "标题 4" Then
d = d + 1
e = 0
ActiveDocument.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(.Text, "`") - 1).End).Text = a & "." & b & "." & c & "." & d
ElseIf .Style = "标题 5" Then
e = e + 1
ActiveDocument.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(.Text, "`") - 1).End).Text = a & "." & b & "." & c & "." & d & "." & e
End If
End If
End With
Next
.Content.Find.Execute "`", , , 0, , , , , , " ", 2
'''All Format
With .Content
With .Font
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.LineSpacing = LinesToPoints(1.5)
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
.KeepWithNext = False
.KeepTogether = False
End With
End With
If .Characters(1).Text <> "第" Then
With .Paragraphs(1).Range
.Style = wdStyleTitle
.Font.Size = 26
End With
End If
End With
Selection.HomeKey 6
End Sub

复制代码

风之飘雨 · 发表于 2019-12-6 09:40

膜拜大神~虽然自己用不上，但是不明觉厉

喽喽ll · 发表于 2020-3-13 16:52

谢谢分享试试效果

阿里先生 · 发表于 2020-3-16 10:30

求教老师一下，我怎么把代码导入到WORD中呀

413191246se · 发表于 2020-3-17 01:20

请新建一个宏，然后，按 Alt + F11 找到它，复制我的代码到它的下面即可。

dklwajhdlkjh · 发表于 2020-4-29 09:04

在word2019上运行会出现。“集合所要求的成员不存在”是怎么回事啊

dengcaimao · 发表于 2020-10-15 18:54

留个记号，先收藏下，word的内置编号功能用得不好反而烦人，研究下这个代码

shenjianrong163 · 发表于 2021-2-1 18:57

谢谢分享！

烧包小丫 · 发表于 2021-10-10 13:15

您好，我试了下有错误，第2级标题的1.1总是跟第一章在一排上是什么情况

烧包小丫 · 发表于 2021-10-10 13:16

shenjianrong163 发表于 2021-2-1 18:57
谢谢分享！

您是否在，我想请教下多级列表自动编号这个宏，我的老是出错

		自动登录	找回密码
密码			免费注册

[分享] 多级标题自动编号（宏）

评分

评分