如何在 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 Blocks45\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

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 Blocks45\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 的多个隐藏实例。

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

How to use BuildingBlockEntry().insert method in Word Document with Excel VBA?

excel

vba

ms-word

insert