excel - VBA-替换数据和创建新文档

Question

所以我试图加载一个单词模板，然后用数据填充该模板，最后根据单元格的文件路径将其保存为单词或 PDF 文档。

我还有 4 个其他宏，一个用于从模板将数据填充到工作表中，然后 3 个用于分别选择保存位置、发票模板和数据源。

我认为 Dim WordContent As WordRange 有问题，但在启用 Microsoft Office、Excel、Forms 和 Word 16.0 对象库后，编译错误消失了。

有点卡住-不知道为什么它不创建/保存word文档。原始发票模板也没有被覆盖，所以我真的不知道出了什么问题。

它显示该单词弹出，并在完成后关闭，但没有保存任何内容..

    Sub CreateTaxReceipt()
Dim CustRow, CustCol, LastRow As Long
Dim DocLoc, TagName, TagValue, FileName As String
Dim CurDt, LastAppDt As Date
Dim WordDoc, WordApp As Object
Dim Path1 As String
Dim WordContent As Word.Range
With Sheet1

 If .Range("B3").Value = Empty Then
MsgBox "Please select an Invoice template from the drop down list"
.Range("G3").Select
Exit Sub
 End If

If .Range("B4").Value = Empty Then
MsgBox "Please select Data from the drop down list"
.Range("G4").Select
Exit Sub
  End If

  If .Range("B5").Value = Empty Then
MsgBox "Please select Save Location from the drop down list"
.Range("G5").Select
Exit Sub
 End If



'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If err.Number <> 0 Then
'Launch a new instance of Word
err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If


LastRow = .Range("E9999").End(xlUp).Row  'Determine Last Row in Table
    For CustRow = 8 To LastRow
                            Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
                            For CustCol = 5 To 14 'Move Through 8 Columns
                                TagName = .Cells(7, CustCol).Value 'Tag Name
                                TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                                 With WordDoc.Content.Find
                                    .Text = TagName
                                    .Replacement.Text = TagValue
                                    .Wrap = wdFindContinue
                                    .Execute Replace:=wdReplaceAll 'Find & Replace all instances
                                 End With
                            Next CustCol
                    If .Range("I3").Value = "PDF" Then
                                    Path1 = Range("B5")
                                   FileName = Path1 & "\" & .Range("F" & CustRow).Value & ".pdf" 'Create full filename & Path with current workbook location, Last Name & First Name
                                   WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
                                   WordDoc.SaveAs FileName
                                   WordDoc.Close False
                               Else: 'If Word
                                  Path1 = Range("B5")
                                   FileName = Path1 & "\" & .Range("F" & CustRow).Value & ".docx"
                                   WordDoc.SaveAs FileName
                               End If
    Next CustRow
    WordApp.Quit
End With
End Sub

标签： excelvba