哪位大神能写手动编号转为自动编号的代码？

sylun

晨晓之黎 发表于 2021-1-17 01:01
sylun老师，我刚测试了你的代码，表格内的数字单级编号效果不错！转为自动编号和手动编号完全一致！太厉 ...

按楼主新要求增加了处理小写字母编号部分，可试试。
原代码本来就提供了删除原自动编号的代码行，只是为了方便对照而将其注释掉。
该自动编号是多级的，会根据其前一级依次自动重新编号。因文档前面目前中有符合编号格式的段落，程序会将其处理，楼主可手动取消其自动编号。
建议楼主多了解一引起使用宏的知识，当然最好能读懂甚至会写一点，或修改一下。

1. Sub test()
   
2.     Dim i As Integer
   
3.     Dim myListTemplate As ListTemplate
   
4.    
   
5.     Set myListTemplate = ListGalleries(wdOutlineNumberGallery).ListTemplates(1)
   
6.     For i = 1 To 5
   
7.         With myListTemplate.ListLevels(i)
   
8.             .NumberFormat = Choose(i, "%1.", "%1.%2", "%1.%2.%3", "%4.", "%5.")
   
9.             .TrailingCharacter = wdTrailingTab
   
10.             .NumberStyle = IIf(i < 5, 0, 4)
    
11.             .NumberPosition = 0
    
12.             .Alignment = wdListLevelAlignLeft
    
13.             .TextPosition = 21
    
14.             .ResetOnHigher = True
    
15.             .StartAt = 1
    
16.         End With
    
17.     Next
    
18.    
    
19.     i = 0
    
20.     Application.ScreenUpdating = False
    
21.     With ActiveDocument.Content.Find
    
22.         .Text = "[0-9][0-9.]@[^9^32]"
    
23.         .MatchWildcards = True
    
24.         Do While .Execute = True
    
25.             With .Parent '假设1级手动编号在表外，2-4级编号均在表内第1列，否则不处理
    
26.                 If .Information(wdWithInTable) = False And .Start = .Paragraphs(1).Range.Start And Right(.Text, 2) = "." & vbTab Then
    
27.                     i = i + ApplyListTemp(.Duplicate, myListTemplate, 1)
    
28.                 ElseIf .Information(wdWithInTable) = True And .Start = .Paragraphs(1).Range.Start And UBound(Split(.Text, ".")) = 1 Then
    
29.                     If Right(.Text, 2) = ". " And .Cells(1).ColumnIndex = 1 Then
    
30.                          i = i + ApplyListTemp(.Duplicate, myListTemplate, 4)
    
31.                     ElseIf .Cells(1).ColumnIndex = 1 Then
    
32.                         i = i + ApplyListTemp(.Duplicate, myListTemplate, 2)
    
33.                     End If
    
34.                 ElseIf .Information(wdWithInTable) = True And .Start = .Paragraphs(1).Range.Start And UBound(Split(.Text, ".")) = 2 Then
    
35.                     If .Cells(1).ColumnIndex = 1 Then i = i + ApplyListTemp(.Duplicate, myListTemplate, 3)
    
36.                 End If
    
37.             End With
    
38.         Loop
    
39.         
    
40.         .Parent.WholeStory   '处理表格内首列的手动小写字母编号
    
41.         .Text = "[a-z].^9"
    
42.         Do While .Execute = True
    
43.             With .Parent
    
44.                 If .Information(wdWithInTable) = True And .Start = .Paragraphs(1).Range.Start Then _
    
45.                     If .Cells(1).ColumnIndex = 1 Then i = i + ApplyListTemp(.Duplicate, myListTemplate, 5)
    
46.             End With
    
47.         Loop
    
48.     End With
    
49.    
    
50.     Application.ScreenUpdating = True
    
51.     MsgBox "共修改了" & i & "个段落", vbInformation
    
52. End Sub
    
53. 
    
54. Function ApplyListTemp(myRange As Range, LT As ListTemplate, i As Integer) As Integer
    
55.     With myRange
    
56.         .ListFormat.ApplyListTemplateWithLevel LT, True, wdListApplyToWholeList, wdWord10ListBehavior, i
    
57.         .Paragraphs(1).Range.HighlightColorIndex = wdYellow  '突出显示经修改段落
    
58.         .Text = Empty '删除原非自动编号
    
59.     End With
    
60.     ApplyListTemp = 1
    
61. End Function

复制代码

晨晓之黎

sylun 发表于 2021-1-17 22:15
按楼主新要求增加了处理小写字母编号部分，可试试。
原代码本来就提供了删除原自动编号的代码行，只是为 ...

谢谢sylun老师！可以了！我这还有手动多级编号（1-7级标题），项目符号（黑色圆、白色圆、实力方形）这些种常用的，能不能请老师帮忙写转为自动的？能否加QQ？方便沟通，给你示例文件

zpy2

晨晓之黎 发表于 2021-1-18 15:31
谢谢sylun老师！可以了！我这还有手动多级编号（1-7级标题），项目符号（黑色圆、白色圆、实力方形）这些 ...

With ActiveDocument.Content.Find
  .Text = "[0-9][0-9.]@[^9^32]"
  .MatchWildcards = True

现在是手动到自动，那天，要自动到手动，难度估计更大。

晨晓之黎

zpy2 发表于 2021-1-18 15:41
With ActiveDocument.Content.Find
  .Text = "[0-9][0-9.]@[^9^32]"
  .MatchWildcards = True

没有啊，现在一直都是转为自动的With ActiveDocument.Content.Find
  .Text = "[0-9][0-9.]@[^9^32]"
  .MatchWildcards = True
这个是什么意思？我试了没反应