在word中，或者html中，怎么批量把特定标记转换成脚注或者尾注？

mib4748

在word中，或者html中，怎么批量把特定标记转换成脚注或者尾注？







补充内容 (2020-3-1 11:26):
附件在回复下面

weiyingde

最少也要个附件，不然人家怎么帮你？

mib4748

weiyingde 发表于 2020-2-20 16:05
最少也要个附件，不然人家怎么帮你？

好的，附件上传

mib4748

在word中，或者html中，怎么批量把特定标记转换成脚注或者尾注？

sylun

可试试如下批量转换成脚注的代码。尾注的做法也差不多，只是原文档没有进行必要的分节，尾注太多都集中在文档末尾，似不符常规。

1. Sub test()
   
2.     '查找匹配并据以插入脚注，删除原标记文本，未删除原注释文本
   
3.     Dim i As Integer
   
4.     Dim j As Integer
   
5.     Dim response As Integer
   
6.     Dim alocation() As Long '注释起始位置参数
   
7.     Dim fnreference() As String '注释编号
   
8.     Dim fntext() As String '注释编号及文本，假设文本中没有制表符，且只是一个段落内容
   
9.     Dim st As Single
   
10.    
    
11.     st = Timer
    
12.     Application.ScreenUpdating = False
    
13.     Documents.Add ActiveDocument.FullName
    
14.    
    
15.     If ActiveDocument.Footnotes.Count > 0 Then
    
16.         MsgBox "文档中已存在脚注，程序退出！"
    
17.         Exit Sub
    
18.     End If
    
19.     With ActiveDocument.Content.Find
    
20.         .MatchWildcards = True
    
21.         .Forward = False
    
22.         '查找原标记文本，该文本不能在段落开头，不判断编号是否按顺序排列
    
23.         Do While .Execute("[!^13][\[][0-9]@\-[0-9]@[\]]")
    
24.             With .Parent
    
25.                 ReDim Preserve alocation(i)
    
26.                 ReDim Preserve fnreference(i)
    
27.                 alocation(i) = .Start + 1
    
28.                 fnreference(i) = Mid(.Text, 2)
    
29.             End With
    
30.             i = i + 1
    
31.         Loop
    
32.         
    
33.         i = 0
    
34.         .Parent.EndOf wdStory
    
35.         '查找原注释文本，该文本应为整个段落
    
36.         Do While .Execute("^13[\[][0-9]@\-[0-9]@[\]][!^13]")
    
37.             With .Parent
    
38.                 .SetRange .Start + 1, .Paragraphs(2).Range.End - 1
    
39.                 ReDim Preserve fntext(i)
    
40.                 fntext(i) = Split(.Text, "]")(0) & "]" & vbTab & Mid(.Text, InStr(.Text, "]") + 1)
    
41.                  '标记编号与注释条目编号不对应时选定问题注释文本后退出程序
    
42.                 If Split(fntext(i), vbTab)(0) <> fnreference(i) Then
    
43.                     .Select
    
44.                     MsgBox "标记编号与注释编号不对应！"
    
45.                     Exit Sub
    
46.                 End If
    
47.                 .Collapse wdCollapseStart
    
48.             End With
    
49.             i = i + 1
    
50.         Loop
    
51.     End With
    
52.    
    
53.     ActiveDocument.Range.FootnoteOptions.Location = wdBottomOfPage '
    
54.     For i = 0 To UBound(alocation)
    
55.         With ActiveDocument.Range(alocation(i), alocation(i) + Len(fnreference(i)))
    
56.             .Text = "" '测试时可不用本行，以对照
    
57.             .Footnotes.Add .Duplicate, fnreference(i), Split(fntext(i), vbTab)(1) '沿用自定义脚注标记文字
    
58. '            .Footnotes.Add .Duplicate, fnreference(i), fntext(i)  '测试时可用本行对照，不用上一行
    
59.         End With
    
60.     Next
    
61.     Documents.Add.Content.Text = "脚注标记与注释文本如下：" & vbCrLf & Join(fntext, vbCrLf)
    
62.     MsgBox "共插入了" & i & "个脚注。处理后的文档及脚注列表见新文档。用时" & Int(Timer - st) & "秒"
    
63.     Application.ScreenUpdating = True
    
64. End Sub

复制代码

mib4748

sylun 发表于 2020-3-3 20:32
可试试如下批量转换成脚注的代码。尾注的做法也差不多，只是原文档没有进行必要的分节，尾注太多都集中在文 ...

非常感谢！