VBA：从模板创建新文档，搜索和替换文本答案

【问题标题】：VBA: Create new document from template, search and replace textVBA：从模板创建新文档，搜索和替换文本
【发布时间】：2021-10-01 10:48:33
【问题描述】：

在我尝试了一整天并没有找到正确的解决方案之后，论坛是我最后的希望。

我想实现什么？我有一个 Word 模板（.dotm 文件），我在此基础上创建了一个新文档。在新文档中，我想用另一个值替换某个文本。然后，该文件应与替换的文本一起保存。

这已经可以了：

创建新文件
保存新文件

当我尝试替换文本时会发生以下情况：要替换的文本在模板中被替换。新文件保持不变。

我尝试过什么来解决这个问题？

激活新文档所在的 Word 实例。
设置选择和范围（我很难控制正确的选择对象是否在选择对象中）。

这是我的代码的样子：

'Platzierungsdatei öffnen
Set excel = CreateObject("excel.application")
excel.Workbooks.Open FileName:=pfadUrkunden

'Word Instanz öffnen
Dim wdDocument As Object
Dim Word As Object
Set Word = CreateObject("Word.Application")
 
Do While excel.Worksheets("TN").Cells(iIndex, 1).Value <> ""
    sName = excel.Worksheets("TN").Cells(iIndex, 1).Value
     
    Set wdDocument = Word.Documents.Add(vorlagePfad)
    Word.Visible = True
    '[Vorname Nachname] ersetzen
    Word.Activate
    ActiveDocument.Shapes.Range(Array("Textfeld 2")).Select
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[Vorname Nachname]"
        .Replacement.Text = sName
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
     
    ausgabeOrdner = ausgabeOrdner & "\" & sName
    wdDocument.SaveAs (ausgabeOrdner)

    '+55 um nur einen Eintrag zu testen
    iIndex = iIndex + 55
Loop
 
Word.Quit
Set Word = Nothing

excel.Quit

我有 Office 365 并尝试从 .dotm 文件运行程序。

我寻求帮助并感谢任何想法！

对我代码中的德国 cmets 感到抱歉，请随时提问 :)

非常感谢！

【问题讨论】：

标签： excel vba replace ms-word

【解决方案1】：

使用您发布的代码无法更改模板中的任何内容，除非您已经打开模板并且它是活动文档。

您的代码在wdDocument、ActiveDocument 和Selection 之间切换时一团糟。

ActiveDocument 应替换为 wdDocument，因为这是您的代码应该使用的文档。这消除了与其他打开的文档混淆的任何可能性，并避免了激活工作文档的需要。

Selection 最好避免使用，因为在 VBA 中工作时很少需要选择任何内容。由于您不会选择任何内容，因此无需使 Word 可见。

Set wdDocument = Word.Documents.Add(vorlagePfad)
'[Vorname Nachname] ersetzen
With wdDocument.Shapes("Textfeld 2").TextFrame.TextRange.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[Vorname Nachname]"
    .Replacement.Text = sName
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
End With

【讨论】：