[分享]脚注与段落的宏代码

守柔

[应网友的来信所作]这是一个将已有文档脚注内容写在脚注所在段落下方并保留原有编号（所有编号仍保留有上标）的代码，与大家分享。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-3-11 09:38:10 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub InsertFootNotes() Dim F As Footnote, P As Paragraph, MyString As String On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新 For Each P In ActiveDocument.Paragraphs '在段落中循环 For Each F In ActiveDocument.Footnotes '在脚注中循环 If F.Reference.InRange(P.Range) Then '如果是本段落中的脚注 '在内存中累加文本,并加注特别标识符以便查找 MyString = MyString & "序号" & F.Index & "留白" & F.Range & Chr(13) End If Next P.Range.InsertAfter MyString '段落结尾插入 MyString = "" '初始化变量 Next Application.ScreenUpdating = True '恢复屏幕更新 Call ReplaceNumber End Sub '---------------------- Sub ReplaceNumber() Dim i As Byte, MyFind As String, N As Integer, TF As Boolean On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新 For i = 1 To 2 N = ActiveDocument.Footnotes.StartingNumber '初始化变量值为脚注起始编号 MyFind = VBA.IIf(i = 1, "^f", "序号*留白") '查找文字 TF = VBA.IIf(i = 1, False, True) '是否支持通配符查找 Selection.HomeKey unit:=wdStory '移到文档首位置 With Selection.Find '设置查找条件 .ClearFormatting '清除查找格式 .Replacement.ClearFormatting ''清除替换格式 .Text = MyFind '查找的文字 .MatchWildcards = TF '是否支持通配符 While .Execute '每次成功执行 With Selection .Text = N '改变所选内容文本 N = N + 1 '累加 .Font.Superscript = True '设为上标 .HomeKey unit:=wdStory '移到文档首 End With Wend End With Next Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

守柔

Not an unswer question .....

班长

斑主的功力深不可测，研究这样问题对于俺们来说，就象要刚把10个阿拉伯数字认全的幼儿大班的小孩去研究微积分一样困难，目前能做的就是收藏！