使用 VBA 宏填充 Word 文档而不覆盖基本文件

Question

我编写了VBA代码来填充基于Excel表格的Word文档。

基本模型 Word 文件会被新的填充文档覆盖。

我必须将模型文件替换为空模型文件才能再次运行。

Sub AnexoF_CPFL()

Dim Linha As Integer
Linha = InputBox("Qual a linha do projeto?", "Gerar Anexo F CPFL")

Set objWord = CreateObject("Word.Application")

objWord.Visible = True

Set arqAnexoF = objWord.Documents.Open("C:\Users\Axis\Axis Renováveis Dropbox\Pasta da equipe                Axis Renováveis\Axis Renovaveis Server\4 - Operações\1. Desenvolvimento\2. Prospecção\Consultas de Acesso\Macros\Modelos\CPFL\AnexoF.docx")
Set conteudo = arqAnexoF.Application.Selection

For i = 2 To 25
    conteudo.Find.Text = Cells(1, i).Value
    conteudo.Find.Replacement.Text = Cells(Linha, i).Value
    conteudo.Find.Execute Replace:=wdReplaceAll
Next

arqAnexoF.SaveAs2 Filename:="C:\Users\Axis\Axis Renováveis Dropbox\Pasta da equipe Axis Renováveis\Axis Renovaveis Server\4 - Operações\1. Desenvolvimento\2. Prospecção\Consultas de Acesso\CPFL Paulista\Consultas\" & "Anexo F - " & Cells(Linha, 2), FileFormat:=17

arqAnexoF.Close
objWord.Quit

Set arqAnexoF = Nothing
Set conteudoDoc = Nothing
Set objWord = Nothing

MsgBox ("Anexo F CPFL gerado com sucesso!")

End Sub

我尝试复制一个新文件，然后填充信息，但失败了。

Answer 1

您确实应该使用“AnexoF”的 Word 模板（即“AnexoF.dotx”）而不是普通的 Word 文档。除此之外，例如通过双击打开模板，创建一个新文档，从而最大限度地减少覆盖它的机会。您还应该声明所有变量，并且由于您使用的是后期绑定，因此需要在使用它们之前分配 Word 常量（或者仅使用它们的数字枚举）。然后你可以使用如下代码：

Sub AnexoF_CPFL()
Dim xlSht As Worksheet, objWord As Object, objDoc As Object, Linha As Long, i As Long, StrPath As String
Const wdFindContinue As Long = 1: Const wdReplaceAll As Long = 2: Const wdFormatPDF As Long = 17
Linha = InputBox("Qual a linha do projeto?", "Gerar Anexo F CPFL")
StrPath = "C:\Users\Axis\Axis Renováveis Dropbox\Pasta da equipe Axis Renováveis\Axis Renovaveis Server\" & _
          "4 - Operações\1. Desenvolvimento\2. Prospecção\Consultas de Acesso\"
Set xlSht = ActiveSheet
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add(StrPath & "\Macros\Modelos\CPFL\AnexoF.dotx")
With objDoc
  With .Range.Find
    .Wrap = wdFindContinue
    For i = 2 To 25
      .Text = xlSht.Cells(1, i).Value
      .Replacement.Text = xlSht.Cells(Linha, i).Value
      .Execute Replace:=wdReplaceAll
    Next
  End With
  .SaveAs2 Filename:=StrPath & "CPFL Paulista\Consultas\" & "Anexo F - " & xlSht.Cells(Linha, 2) & ".pdf", _
      FileFormat:=wdFormatPDF
  .Close
End With
objWord.Quit
Set arqAnexoF = Nothing: Set objWord = Nothing: Set xlSht = Nothing
MsgBox ("Anexo F CPFL gerado com sucesso!")
End Sub