excel - 如何在 Excel VBA 的 Word 文档中使用 BuildingBlockEntry().insert 方法？

Question

大部分代码是从How to use VBA to insert Excel data into Word, and export it as PDF? .

有什么方法可以通过 Excel VBA 在 Word 文档中插入来自 quickparts-buildingblocks 的文本？

这会冻结 Excel：

wordDoc.Application.Templates(...).BuildingBlockEntries("test").Insert Where:=Selection.Range, RichText:=True

代码：

Sub Generate()
Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsGenerator As Worksheet
Set wsGenerator = wb.Sheets("List")

Dim wordApp As Word.Application
Set wordApp = New Word.Application

Dim wordDoc As Word.Document
Dim name1, name2, name3, name4 As String
Dim n, j As Integer

n = wsGenerator.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n

    Set wordDoc = wordApp.Documents.Open("C:\Users\" & Environ("username") & "\Desktop\ExcelTest\Template.docx")
        
    wordApp.Templates.LoadBuildingBlocks

    name1 = wsGenerator.Range("A" & j).Value
    name2 = wsGenerator.Range("B" & j).Value
    name3 = wsGenerator.Range("C" & j).Value
    name4 = wsGenerator.Range("D" & j).Value

    If name4 = "" Then
        wordDoc.Application.Templates( _
          Environ("AppData") & "\Microsoft\Document Building Blocks\1045\16\Building Blocks.dotx" _
          ).BuildingBlockEntries("test").Insert Where:=Selection.Range, RichText:=True
    End If

    With wordDoc.Content.Find
        .Execute FindText:="<<name1>>", ReplaceWith:=name1, Replace:=wdReplaceAll
        .Execute FindText:="<<name2>>", ReplaceWith:=name2, Replace:=wdReplaceAll
        .Execute FindText:="<<name3>>", ReplaceWith:=name3, Replace:=wdReplaceAll
        .Execute FindText:="<<name4>>", ReplaceWith:=name4, Replace:=wdReplaceAll
    End With

    wordDoc.ExportAsFixedFormat "C:\Users\" & Environ("Username") & "\Desktop\ExcelTest\" & wsGenerator.Range("A" & j).Value & " " & wsGenerator.Range("C" & j).Value & ".pdf", _
      wdExportFormatPDF

    wordDoc.Close (wdDoNotSaveChanges)

Next
End Sub

标签： excelvbams-wordinsert

Answer 1

您的代码有几个问题。

首先，wordDoc.Application将失败，因为Application它不是文档的子对象。您已经设置了一个变量，wordApp指向 Word Application 对象并需要使用它。

其次，您只需要加载一次构建块，而不是在循环的每次迭代期间。

第三，在 VBA 中，变量声明： Dim name1, name2, name3, name4 As String 将导致只是name4一个字符串，而所有变量都具有 Variant 的默认数据类型。

纠正这些问题后，您的代码将是：

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsGenerator As Worksheet
Set wsGenerator = wb.Sheets("List")

Dim wordApp As Word.Application
Set wordApp = New Word.Application

Dim wordDoc As Word.Document
Dim name1 As String, name2 As String, name3 As String, name4 As String
Dim n, j As Integer

n = wsGenerator.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

'load building blocks
Dim bblockSource As String
bblockSource = Environ("appdata") & "\Microsoft\Document Building Blocks\1045\16\Building Blocks.dotx"
wordApp.Templates.LoadBuildingBlocks

For j = 2 To n

    Set wordDoc = wordApp.Documents.Open("C:\Users\" & Environ("username") & "\Desktop\ExcelTest\Template.docx")
    

    name1 = wsGenerator.Range("A" & j).Value
    name2 = wsGenerator.Range("B" & j).Value
    name3 = wsGenerator.Range("C" & j).Value
    name4 = wsGenerator.Range("D" & j).Value

    If name4 = "" Then
        wordApp.Templates(bblockSource).BuildingBlockEntries("test").Insert Where:=wordApp.Selection.Range, RichText:=True
    End If

    With wordDoc.Content.Find
        .Execute FindText:="<<name1>>", ReplaceWith:=name1, Replace:=wdReplaceAll
        .Execute FindText:="<<name2>>", ReplaceWith:=name2, Replace:=wdReplaceAll
        .Execute FindText:="<<name3>>", ReplaceWith:=name3, Replace:=wdReplaceAll
        .Execute FindText:="<<name4>>", ReplaceWith:=name4, Replace:=wdReplaceAll
    End With

    wordDoc.ExportAsFixedFormat "C:\Users\" & Environ("Username") & "\Desktop\ExcelTest\" & wsGenerator.Range("A" & j).Value & " " & wsGenerator.Range("C" & j).Value & ".pdf", _
        wdExportFormatPDF

    wordDoc.Close (wdDoNotSaveChanges)

Next

您还需要注意，您的代码在完成后不会关闭 Word，这可能会导致 Word 的多个隐藏实例。