手动编号转自动编号（宏）测试版

413191246se · 发表于 2016-12-20 22:03

似乎有朋友很需要手动编号转自动编号，我是不太需要，但当作练习，编了一个，有需要的朋友们可以测试一下，测试文本如下：（因水平有限，大多数是录制宏）
中华人民共和国。
1.中国。
35、人民。
672.解放军。
中华人民共和国中华人民共和国。中华人民共和国中华人民共和国中华人民共和国中华人民共和国中华人民共和国中华人民共和国中华人民共和国。

Sub 手动编号转自动编号_TEST()
'功能：如果有选定，则设置选定段落；否则，如果未选，则设置全文！
Dim myRange As Range
If Selection.Type = wdSelectionIP Then Selection.WholeStory
Set myRange = Selection.Range
'设置选定段落自动编号（录制宏）
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(1.98)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(2.72)
.TabPosition = CentimetersToPoints(2.72)
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
wdNumberGallery).ListTemplates(1), ContinuePreviousList:=False, ApplyTo:= _
wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
'删除手动编号
myRange.Select
Dim i As Paragraph
For Each i In Selection.Paragraphs
i.Range.Characters(1).Select
Do While Selection.Characters.Last Like "#"
Selection.MoveEnd unit:=wdCharacter, Count:=1
Loop
If Selection Like "*[、.．]" Then Selection.Delete
myRange.Select
Next
'制表位（录制宏）
Selection.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = CentimetersToPoints(0.19)
'左缩进（录制宏）
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.74)
.FirstLineIndent = CentimetersToPoints(-0.74)
End With
End Sub

复制代码

413191246se · 发表于 2016-12-20 22:24

发现问题：我 1 楼的宏，是解决连续选定区域的，不连续选定区域无能为力。

loquat · 发表于 2016-12-25 21:53

佳作，还可以扩展一下。
判断一下手动编号的格式。
例如1. 1、一、①等等

413191246se · 发表于 2016-12-25 22:29

____谢谢老朋友！——其实我并没有手动编号转自动编号的需要，我最感兴趣的还是自动排版，当然很初级的。就连 1.1.1 这样的多级编号也没用过，因为从来没有需要。
____最近，我为我刚完成的《Word2003通用模板宏2017元旦版》的成功发布而沾沾自喜，但是随后又发现，在处理大文本时，难免有慢的时候，原因就在于，有不少操作我都是用 Selection对象/Select方法的，而不是用 Range区域对象。
____刚才联想到你和杜先生原来说过的尽量用 Range（区域）对象来操作的问题，因为这个我不太会，我就根据《替换全角数字字母为半角》这个宏（不知是哪位高人编写的！因为我刚开始弄不懂，后来加了 myRange.Select 才弄清楚哪里是哪里）成功改写了我的《标题2自动设置》，如法炮制，标题3/4/5 都要如此，尽量把所有 Selection/Select 都改成 Range。——杜先生（duquancai）的正则虽好，但我觉得难以控制，用不来。——另外，最近根据 tangqingfu 兄的《常用查找与替换操作实例64例》那个文档，我也学到不少《查找和替换》的知识，以后要加强《查找和替换》的应用，一两句查找代码就顶10几句VBA代码。
____未给老朋友的《邮件宏》捧场，SORRY啊！（其实我也想向你求助来着，但后来一想，要是你很忙，打扰你不好，我自己来吧，虽然水平低。——好像杜先生你们都用 Word 2007 以上版本了，2003 的不用了，不好意思求你们了……（罗里罗索，不好意思。）

tangqingfu · 发表于 2016-12-26 10:47

413191246se 发表于 2016-12-25 22:29
____谢谢老朋友！——其实我并没有手动编号转自动编号的需要，我最感兴趣的还是自动排版，当然很初级的。 ...

感谢413191246se兄的分享，兄台的水平和研究精神值得学习！

413191246se · 发表于 2016-12-26 17:13

本帖最后由 413191246se 于 2016-12-26 17:14 编辑

qingfu 兄过奖！小弟现在也只会个皮毛，距杜先生、loquat 那些高人还有很长的距离。
最近看了 qingfu 兄的《查找和替换实例64例》这个文档，受益匪浅，吸收了不少知识。
我看最厉害的当属守柔版主，早在 2004年就出品了《VBA代码集》，比我早了10来年就得大成，得仰视守版。

wdpfox · 发表于 2017-6-13 11:11

学习了，多谢老师慷慨分享好资料！
　　　　　　Oooo
　　　　　　(___)
　　oooO 　 )_/
　　(___) 　 (_/
　　 \_(
　　　\_)

duquancai · 发表于 2017-6-13 13:12

Sub 手动编号_自动编号()
' 多级列表链接样式的运用
Dim P As Range, S As Range
Set P = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
If P = ActiveDocument.Content Then
      k = MsgBox("要进行全文处理吗？", vbYesNoCancel + vbQuestion, "全文处理判断")
      If k <> vbYes Then Exit Sub
End If
Call ListTitle(ActiveDocument)
Set S = P.Duplicate
With P.Find
      Do While .Execute("[0-9]@[、.．]", , , 1)
         If Not P.InRange(S) Then Exit Do
         With P
            x = Len(.Text): ksr = .Text
            .Expand 4: .Collapse
            If .MoveWhile(ksr, x) = x Then
                  .MoveStart , -x: .Text = Empty
                  .Style = ActiveDocument.Styles("s")
            Else
                  .Move 4, 1
            End If
         End With
      Loop
End With
End Sub
Sub ListTitle(doc As Document)
Dim LtTemp As ListTemplate
Set LtTemp = doc.ListTemplates.Add(True)
On Error Resume Next
doc.Styles.Add Name:="s", Type:=1
With LtTemp.ListLevels(1)
      .NumberFormat = "%1.": .NumberStyle = 0
      .TrailingCharacter = 2: .StartAt = 1: .ResetOnHigher = True
      .NumberPosition = InchesToPoints(0)
      .TextPosition = InchesToPoints(0)
      .LinkedStyle = "s"
End With
End Sub

cuteword · 发表于 2017-6-13 15:03

记得我当年写这个功能，代码超过了3000行。

tangqingfu · 发表于 2017-6-14 12:57

duquancai 发表于 2017-6-13 13:12
Sub 手动编号_自动编号()
' 多级列表链接样式的运用
Dim P As Range, S As Range

谢谢杜兄的分享！

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

[原创] 手动编号转自动编号（宏）测试版

评分