分享一个最近写的批量自动编号宏，还有两个小问题

yliuchuyang · 发表于 2022-3-26 12:33

本帖最后由 yliuchuyang 于 2022-3-26 12:43 编辑

最近写了一个自动编号的宏，思路是参考的一个公众号的文章：Word—不用域，查找替换将不连续文本编号变为自动编号
照着这个思路把VBA写出来了，但原文中的一个问题没有解决：
目的：
把所有的“（一）（二）（三）..”这样的序号用通配符找到，然后设置自动编号，但是由于正文中也有引用“（一）（二）” 因此正文中的序号不能匹配，只能查找段首的序号。

思路：
直接用[^13]（[一二三四五六七八九十]@ 利用换行符来定位段首的序号
可是有一个问题1，如果这个序号上面是一个表格，比如这样

利用换行符就匹配不到了，可能是表格后面的换行符和普通的换行符不一样，我在论坛也找了word64例的通配符讲解，没有看到类似的情况

因此只能绕一个弯，先匹配所有前面没有换行符的序号[!^13]（[一二三四五六七八九十]@）
然后加几个字符做标记比如|||
然后再匹配没有标记的序号即段首的序号（[一二三四五六七八九十]@）[!|||]，完成自动编号，最后再把标记去掉。

这样做会带来一个问题2
如果序号不是（一）这样的样式而是“1、 2、 3、”这样的样式
在我匹配[!^13][0-9]@、时，即先把非段首的序号标记这一步
如果段首的序号超过了2位，比如11、 12、那么其中的1、 2、也就是个位数开始也符合这个规则，因为他们的前面还有十位数，而并不是换行符
因此这种方法不能处理没有括号包围的序号

如果能解决问题1，那么问题2也不存在了
不知道我说清楚了没有，代码和附件都上传了，麻烦大神也帮我看下出下主意。
感谢各位~

Sub 自动编号_中文括号数字()
Dim r As Range, p As Range, tpf, NF, NS, LI, FI
'================================================== 配置区
tpf = "（[一二三四五六七八九十]@）" '通配符
NF = "（%1）" '编号格式,%1为编号本身,不能动,只需要编辑%1旁边的格式,比如'(一)'为'（%1）' 或者 '1、'为 '%1、' 或者 '第一章'为'第%1章'
NS = wdListNumberStyleSimpChinNum3 '编号的样式:wdListNumberStyleArabic阿拉伯数字 wdListNumberStyleSimpChinNum3中文数字
LI = CentimetersToPoints(0) '左缩进
FI = CentimetersToPoints(0.74) '首行缩进
'================================================== 配置区
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
MsgBox "请选择范围！"
Exit Sub
Else
Set r = Selection.Range
Set p = Selection.Range
End If
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1) '设置编号格式
.NumberFormat = NF
.TrailingCharacter = wdTrailingNone
.NumberStyle = NS
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 0
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
With r.Find '标识后面的注释引用
.Text = "[!^13]" & tpf
.Replacement.Text = "^&|||"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With r.Find '查找非注释引用部分并自动编号
.ClearFormatting
.Text = tpf & "[!|||]"
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
If .End > p.End Then Exit Do
.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LeftIndent = LI
.FirstLineIndent = FI
End With
.Start = .End
End With
Loop
End With
With p.Find '替换本来存在的序号
.Text = tpf & "([!|||])"
.Replacement.Text = "\1"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With p.Find '替换注释标识
.Text = "|||"
.Replacement.Text = ""
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
MsgBox "完成"
End Sub
Sub 自动编号_阿拉伯数字无括号()
Dim r As Range, p As Range, tpf, NF, NS, LI, FI
'================================================== 配置区
tpf = "[123456789]@、" '通配符
NF = "%1、" '编号格式,%1为编号本身,不能动,只需要编辑%1旁边的格式,比如'(一)'为'（%1）' 或者 '1、'为 '%1、' 或者 '第一章'为'第%1章'
NS = wdListNumberStyleArabic '编号的样式:wdListNumberStyleArabic阿拉伯数字 wdListNumberStyleSimpChinNum3中文数字
LI = CentimetersToPoints(0) '左缩进
FI = CentimetersToPoints(0.74) '首行缩进
'================================================== 配置区
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
MsgBox "请选择范围！"
Exit Sub
Else
Set r = Selection.Range
Set p = Selection.Range
End If
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1) '设置编号格式
.NumberFormat = NF
.TrailingCharacter = wdTrailingNone
.NumberStyle = NS
.NumberPosition = 0
.Alignment = wdListLevelAlignLeft
.TextPosition = 0
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
With r.Find '标识后面的注释引用
.Text = "[!^13]" & tpf
.Replacement.Text = "^&|||"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With r.Find '查找非注释引用部分并自动编号
.ClearFormatting
.Text = tpf & "[!|||]"
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
If .End > p.End Then Exit Do
.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LeftIndent = LI
.FirstLineIndent = FI
End With
.Start = .End
End With
Loop
End With
With p.Find '替换本来存在的序号
.Text = tpf & "([!|||])"
.Replacement.Text = "\1"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
With p.Find '替换注释标识
.Text = "|||"
.Replacement.Text = ""
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
MsgBox "完成"
End Sub

复制代码

zhanglei1371 · 发表于 2022-3-26 18:44

很简单，直接查找[一二三四五六七八九十]@，此时会连同段落中间的也一并包含进去，然后使用asc(前面的一个字符)是否等于13就可以了。

wdpfox · 发表于 2022-3-26 18:56

本帖最后由 wdpfox 于 2022-3-27 23:12 编辑

解决问题

yliuchuyang · 发表于 2022-3-26 20:36

zhanglei1371 发表于 2022-3-26 18:44
很简单，直接查找[一二三四五六七八九十]@，此时会连同段落中间的也一并包含进去，然后使用asc(前面的一个 ...

老师您好，前面的一个字符用vba怎么表示呢，我先find.Execute之后匹配的内容还会有前面的换行符吗？

yliuchuyang · 发表于 2022-3-26 20:44

yliuchuyang 发表于 2022-3-26 20:36
老师您好，前面的一个字符用vba怎么表示呢，我先find.Execute之后匹配的内容还会有前面的换行符吗？

我明白了，获取位置后再-1吧应该是

zhanglei1371 · 发表于 2022-3-26 21:01

yliuchuyang 发表于 2022-3-26 20:44
我明白了，获取位置后再-1吧应该是

是的，很简单。

yliuchuyang · 发表于 2022-3-26 21:43

zhanglei1371 发表于 2022-3-26 21:01
是的，很简单。

解决了，非常感谢老师！

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

[分享] 分享一个最近写的批量自动编号宏，还有两个小问题