使用宏（Microsoft Word）自动执行手动处理
杰森（Jason）是学术法律期刊的学生编辑。在发布过程中，他需要检查每个句子的抄袭和准确性，以及每个引用，以确保正确的格式和支持。
基本上，这意味着每个句子都必须由脚注中的引用来支持。当前，工作人员手动将作者手稿（Word文档）中的每个文本语句，脚注和脚注编号粘贴并粘贴到工作人员编辑的Word文档中，然后进行检查。 Jason想知道是否有一种方法可以自动完成将手稿源文档中的“脚注编号”，“文章文档中的句子”和“原始脚注内容”复制到工作表文档中的过程。
Jason提到的每个任务都可以通过编程方式完成，但有一些令人讨厌的例外。在VBA中逐步浏览脚注和尾注集合并从中提取信息并不难。然后，可以将此信息移到可用作编辑者工作表的新文档中。令人烦恼的是脚注和尾注的编号是动态的，因此不那么容易访问。
可以在以下站点找到有关该刺激物的完整讨论：
http://www.vbaexpress.com/forum/showthread.php?31231
确切地说，如何制作宏以将信息从一个文档传输到另一文档，很大程度上取决于作者文档中信息的特性。例如，作者的文档在句子后面是否包含一两个空格？每个句子是否允许多个脚注？除脚注外，还允许尾注吗？它包括表格吗？
关键是有许多因素可以影响宏的开发。这意味着任何宏都需要根据您正在使用的源文档进行微调，这意味着需要进行大量测试。但是，为了给您一个起点，请考虑以下宏。他们会将句子，脚注和尾注（如果有）从源文档复制到新文档。
Sub FootnotesEndnotes() Dim fNote As Footnote Dim eNote As Endnote Dim aRange As Range Dim sText As String Dim rText As String Dim eRef As String Dim newDoc As Document Dim oldDoc As Document Set oldDoc = ActiveDocument Set newDoc = Documents.Add sText = "---------------FOOTNOTES---------------" & vbCr newDoc.Content.InsertAfter sText oldDoc.Activate For Each fNote In ActiveDocument.Footnotes Set aRange = fNote.Reference aRange.MoveStart unit:=wdSentence, Count:=-1 aRange.MoveEnd unit:=wdSentence sText = aRange.Text rText = fNote.Range.Text With fNote.Reference.Characters.First .Collapse .InsertCrossReference wdRefTypeFootnote, _ wdFootnoteNumberFormatted, fNote.Index eRef = .Characters.First.Fields(1).Result Selection.Start = fNote.Reference.Start - Len(eRef) Selection.End = fNote.Reference.Start Selection.Delete End With Call WriteNewdoc(newDoc, sText, rText, eRef, "Footnote Text") Next fNote sText = "---------------ENDNOTES----------------" & vbCr newDoc.Content.InsertAfter vbCr & vbCr & sText For Each eNote In ActiveDocument.Endnotes Set aRange = eNote.Reference aRange.MoveStart unit:=wdSentence, Count:=-1 aRange.MoveEnd unit:=wdSentence sText = aRange.Text rText = eNote.Range.Text With eNote.Reference.Characters.First .Collapse .InsertCrossReference wdRefTypeEndnote, _ wdEndnoteNumberFormatted, eNote.Index eRef = .Characters.First.Fields(1).Result Selection.Start = eNote.Reference.Start - Len(eRef) Selection.End = eNote.Reference.Start Selection.Delete End With Call WriteNewdoc(newDoc, sText, rText, eRef, "Endnote Text") Next eNote newDoc.Activate End Sub Sub WriteNewdoc(newDoc As Document, sText As String, rText As String, _ eRef As String, aStyle As String) Dim sText1 As String Dim sText2 As String Dim dRange As Range Dim k As Long Dim curDoc As Document Set curDoc = ActiveDocument newDoc.Activate k = InStr(sText, Chr(2)) If k = 1 Then sText = Mid(sText, 2) 'in case previous sentence has note sText = Trim(sText) k = InStr(sText, Chr(2)) If k = 0 Then sText = sText & Chr(2) k = Len(sText) End If If k > 1 Then sText1 = Left(sText, k - 1) Else sText1 = "" End If If k = Len(sText) Then sText2 = "" Else sText2 = Mid(sText, k + 1) End If If Len(sText2) > 0 Then If Mid(sText2, Len(sText2), 1) = Chr(13) Then sText2 = Left(sText2, Len(sText2) - 1) End If End If Set dRange = newDoc.Content dRange.Collapse Direction:=wdCollapseEnd dRange.Select With Selection .InsertAfter vbCr & sText1 .Font.Superscript = False .Collapse Direction:=wdCollapseEnd .InsertAfter eRef .Font.Superscript = True .Collapse Direction:=wdCollapseEnd .InsertAfter " " & sText2 & vbCr .Font.Superscript = False .Collapse Direction:=wdCollapseEnd .InsertAfter eRef .Font.Superscript = True .Collapse Direction:=wdCollapseEnd .InsertAfter " " & rText & vbCr & vbCr .Font.Superscript = False .Style = aStyle End With curDoc.Activate End Sub
（再次）这只是一个起点。您将需要测试和调整宏与您的文档，以确保它们能够执行您期望的操作。
如果您正在寻找其他资源来帮助开发此类宏，则可以尝试本书。它是一个免费赠品，它可能具有一些可以满足您特定目的的宏（或示例）：
http://www.archivepub.co.uk/book.html
如果您的宏随着时间变得非常复杂，请不要感到惊讶。只要您创建一个宏来执行人类可以用很少的思想就可以完成的任务，这是可以预期的。
注意：
如果您想知道如何使用此页面（或_WordTips_网站上的任何其他页面）中描述的宏，我准备了一个包含有用信息的特殊页面。
_WordTips_是您进行经济有效的Microsoft Word培训的来源。
（Microsoft Word是世界上最流行的文字处理软件。）本技巧（12724）适用于Microsoft Word 2007、2010、2013、2016、2019和Office 365中的Word。