使用给定列表查找和替换宏，保持格式化

Question

我是一个宏观菜鸟，对于这个可能很愚蠢的问题深表歉意。

我正在尝试构建一个宏，它将找到用脚注本身替换一系列脚注占位符的方法，即：

正文

Before music recording artists like Billy Joel, The Police, Journey, and Kool & the Gang rose to international stardom, they transferred or licensed all of their sound recording copyrights to labels, via recording contracts, in exchange for royalties and advancements.[mfn]1[\mfn] The terms of such contracts are reflective of idiosyncratic negotiations, industry customs, and the weak bargaining power of recording artists compared to the record label.[mfn]2[\mfn] Even so, artists have a second bite at the apple: the Copyright Act of 1976 [mfn]3[\mfn] allows artists to terminate any prior grant “notwithstanding any agreement to the contrary” at least thirty-five years after the initial grant for works created “on or after January 1, 1978.”[mfn]4[\mfn] Termination rights safeguard authors and improve bargaining positions by giving authors a second opportunity “to negotiate more advantageous grants in their works after the works ha[ve] been sufficiently ‘exploited’ to determine their ‘value.”’[mfn]5[\mfn]

我正在尝试用格式化的文本替换每个脚注持有者，这些文本可以是普通的、斜体的，甚至是小型大写字母。我只是手动剪切和粘贴每一个，但每个文档和数百个文档都有数百个脚注。现在，我打算替换的脚注位于每个文档底部的单词表中，但我想我需要将它们移动到 excel 文档，其中 A 列是脚注持有者（即 [mfn]1[\ mfn]、[mfn]2[\mfn] 等）和 B 列是我要替换持有人的文本。然而，这可能是完全错误的。

我知道插入我已经尝试过的代码是很常见的做法，但它是如此无望，这将是对每个人的侮辱。我遇到了麻烦：(1) 编写一个 Word 宏来从独立的 excel sheet 中检索值； (2) 保持源格式； (3) 不要破坏过程中的一切。

如有任何帮助，我们将不胜感激。

更新

澄清一下，我正在尝试使用替代脚注（即不是 Word 的默认脚注）从文档中为 Wordpress 创建纯文本脚注。

这是我正在使用的代码，我遇到的问题是错误 5854，因为参数字符串太长（通常 FN 超过 250 个字符）：

Option Explicit

Public Sub WL_FN_Replace_Step_Two()
    Dim ws As Worksheet, msWord As Object, itm As Range

    Set ws = ActiveSheet
    Set msWord = CreateObject("Word.Application")

    With msWord
        .Visible = True
        .Documents.Open "D:\GMLR Website\Test.docx"
        .Activate

        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            For Each itm In ws.UsedRange.Columns("A").Cells

                .Text = itm.Value2                          

                .Replacement.Text = itm.Offset(, 1).Value2  

                .MatchCase = False
                .MatchWholeWord = False

                .Execute Replace:=2     
            Next
        End With
        .Quit SaveChanges:=True
    End With
End Sub

所以这与 excel 有关，因为这是将字符串从 excel 拉回 word 的代码。如果我能解决长度问题，我应该能够让它工作。

Answer 1

有一种非常简单的方法可以做到这一点，而且您不需要宏。这是一个可以帮助您的视频，但它没有涵盖解决您特定问题的主要步骤（尽管它会帮助您很多），我现在将对此进行解释。 https://www.youtube.com/watch?v=do9ujnZLIC4

这是你要做的：

进入word
进入邮件
Select 开始邮件合并
Select Step-by-step 邮件合并向导
Select 信件（在这个例子中我选择了这个，但如果你想通过电子邮件发送它，请使用电子邮件）
Select使用当前文档
点击下一步
在这里，您可以使用现有列表和 select 不同的列表选项导入 excel 列表
单击 select 后，在文件资源管理器中的另一个列表中查找您的 excel。
确保在导入列表后header检查了第一行
核对信息并点击确定
点击底部的下一步
将光标放在您希望占位符所在的位置
点击更多项目
确保您在导入的列表中并单击插入（您必须进出以将光标放在您希望占位符所在的位置）
点击确定然后下一步
确认一切正常
单击下一步，您可以打印为 pdf 或 select 编辑单个字母（您将获得一个包含数据库中所有信息的文档，但是您将在一个文档中收到所有信息，您可以打印它并单独发送它们，但如果您想通过电子邮件发送，我建议您返回步骤 5 并 select 发送电子邮件）

<----编辑---->

这里有关于此工具的更完整的视频https://www.youtube.com/watch?v=mFqCvTOpOL0

Answer 2

尽管撰写文档的人将注释称为脚注，但它们不是 - 它们是尾注。无论如何，对于这样的文档，您可以添加 [mfn] 和 [\mfn] 标签以及它们之间的相关格式化文本，代码如下：

Sub Demo()
Application.ScreenUpdating = False
Dim h As Long, r As Long, RngD As Range, RngH As Range, RngT As Range
With ActiveDocument
  Set RngD = .Range
  RngD.End = .Tables(.Tables.Count).Range.Start
  For h = RngD.Hyperlinks.Count To 1 Step -1
    If IsNumeric(RngD.Hyperlinks(h).TextToDisplay) = True Then
      Set RngH = RngD.Hyperlinks(h).Range: Set RngT = Nothing
      With .Tables(.Tables.Count)
        For r = .Rows.Count To 1 Step -1
          If Split(.Cell(r, 1).Range.Text, vbCr)(0) = RngH.Text Then
            Set RngT = .Cell(r, 2).Range
            With RngT
              .End = .End - 1
              Do While .Characters.Last = vbCr
                .End = .End - 1
              Loop
            End With
            Exit For
          End If
        Next
      End With
      If Not RngT Is Nothing Then
        With RngH
          .Hyperlinks(1).Delete
          .Font.Reset
          .Text = "[mfn][\mfn]"
          .Start = .Start + 5
          .Collapse wdCollapseStart
          .FormattedText = RngT.FormattedText
          .InsertBefore h & " "
        End With
        RngT.Rows(1).Delete
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
End Sub

不清楚您是否打算保留编号。如果不是，删除或注释掉：

          .InsertBefore h & " "

您的示例文档还有两个 'footnotes' 未连接到文档中的任何引用。我保留了原样。

使用给定列表查找和替换宏，保持格式化

Find and Replace Macro With Given List, Keeps Formatting

excel

vba

replace

ms-word

find