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

晨晓之黎

127页表格的编号太多了，一个一个设置为自动编号，这样效率太低了。表格上的手动单级编号转为自动编号，效果如下：

丫头的

试试查找替换，觉得查找替换可以实现

丫头的

试试查找替换，应该可以可以

zpy2

长文档管理word感觉不如markdown方便。

daibao88

Sub bh()
    Dim rg As Range
    Set rg = VBA.IIf(Selection.Type = wdSelectionIP, ActiveDocument.Range, Selection.Range)
    rg.Fields.Unlink
    rg.ListFormat.ConvertNumbersToText
    With rg.Find
        .ClearFormatting
        .Text = "^t"
        .MatchWildcards = True
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
    End With
End Sub

晨晓之黎

zpy2 发表于 2021-1-15 08:36
长文档管理word感觉不如markdown方便。

markdown是什么？我不懂

zpy2

晨晓之黎 发表于 2021-1-15 20:55
markdown是什么？我不懂

https://m.runoob.com/markdown/md-tutorial.html

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 4
   
7.         With myListTemplate.ListLevels(i)
   
8.             .NumberFormat = Choose(i, "%1.", "%1.%2", "%1.%2.%3", "%4.")
   
9.             .TrailingCharacter = wdTrailingTab
   
10.             .NumberStyle = wdListNumberStyleArabic
    
11.             .NumberPosition = CentimetersToPoints(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.     End With
    
40.     Application.ScreenUpdating = True
    
41.     MsgBox "共修改了" & i & "个段落", vbInformation
    
42. End Sub
    
43. 
    
44. Function ApplyListTemp(myRange As Range, LT As ListTemplate, i As Integer) As Integer
    
45.     With myRange
    
46.         .ListFormat.ApplyListTemplateWithLevel LT, True, wdListApplyToWholeList, wdWord10ListBehavior, i
    
47.         .Paragraphs(1).Range.HighlightColorIndex = wdYellow
    
48. '        .Text = Empty '删除原非自动编号
    
49.     End With
    
50.     ApplyListTemp = 1
    
51. End Function

复制代码

晨晓之黎

sylun 发表于 2021-1-16 20:20
可试试：

sylun老师，我刚测试了你的代码，表格内的数字单级编号效果不错！转为自动编号和手动编号完全一致！太厉害了！要是都删除原非自动编号就完美了！多级编号1-4级有影响，只要处理表格内单级编号就好了！a.b.c编号能不能转为自动编号？谢谢！

wdpfox

太深奥了，扑通，扑通掉河里了