使用 Excel 保存带有名称的 Word 文件

Question

我有一个 Word 模板，与 、 等一起使用，然后我在 Excel 中使用 VBA 脚本从单元格中提取数据并将 等替换为单元格中的值.

我现在可以很好地运行它，但是我在保存 Word 文档时遇到了一些麻烦。本质上，我想让 Excel 脚本从单元格中提取文档的名称，然后将该文档作为其名称保存在不同的位置，以免保存在模板上。

基本上我的目标是将数据填充到少数单元格中，然后触发 VBA 脚本，该脚本替换 Word 文档模板上的文本，然后使用特定名称保存文档。

我在Excel VBA to open word template, populate, then save as .docx file somewhere else 尝试了类似问题的答案，但它在我的代码中不起作用。

这是目前已有的代码：

Option Explicit

Public Sub WordFindAndReplace()
Dim ws As Worksheet, msWord As Object

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

With msWord
.Visible = True
.Documents.Open "/Users/Aafrika/Desktop/Test.docx"
.Activate

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

    .Text = "<date>"
    .Replacement.Text = Format(ws.Range("C1").Value2, "dd/mm/yyyy")

    .Forward = True
    .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)

    .Text = "<amount>"
    .Replacement.Text = Format(ws.Range("C2").Value2, "currency")

    .Forward = True
    .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)


End With
.Quit SaveChanges:=True
End With
End Sub

任何关于如何让它发挥作用的想法都会很棒。提前致谢！

Answer 1

处理对象。它会让你的生活变得非常轻松。您正在保存并关闭原始文档。请参阅此示例。这会创建相关对象，然后使用它。

这是你正在尝试的吗？ （未经测试）

Option Explicit

Private Sub WordFindAndReplace()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim msWord As Object
    Dim msWordDoc As Object
    Set msWord = CreateObject("Word.Application")

    msWord.Visible = True
    Set msWordDoc = msWord.Documents.Open("/Users/Aafrika/Desktop/Test.docx")

    With msWordDoc
        With .Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "<date>"
            .Replacement.Text = Format(ws.Range("C1").Value2, "dd/mm/yyyy")

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)

            .Text = "<amount>"
            .Replacement.Text = Format(ws.Range("C2").Value2, "currency")

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        .SaveAs Filename:="Some File Name", FileFormat:=12 'wdFormatXMLDocument
        DoEvents
        .Close (False)
    End With

    msWord.Quit
End Sub