Word VBA 插入目录构建块

Question

我正在尝试使用定义目录的内置构建块之一将目录插入 Word 文档。当我录制宏并插入目录时，宏录制器会给出这行代码：

 Application.Templates( _
        "C:\Users\me\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
        ).BuildingBlockEntries("Automatic Table 1").Insert Where:=Selection.Range, RichText:=True

我已验证此名称 - 自动表 1 - 存在于构建块管理器中。当然，当我使用菜单栏功能区按钮插入目录时，目录确实会正确插入。

但是当我将同一行代码放入 VBA 宏中时，我收到一条错误消息，指出请求的项目不存在。是否可以从 VBA 代码中引用构建块项目？谁能告诉我我做错了什么，或者如何实现我的目标？谢谢。

Answer 1

录制的宏很少能做你想做的事，尤其是在你共享模板时。

编写宏

为此，您需要知道：

• 构建块的名称

• 包含构建块的模板的名称（和位置），除非宏在同一个模板中

• 如何插入宏。 请参阅安装宏和安装/使用 VBA 过程（宏）。

• Building Block Name = "MyBB"（此宏中的示例，更改为适合）

情况 1 和 1a 的 Building Block 和宏位于同一模板中。 这简化了编码，因为宏总是可以告诉 保存它的模板的名称和位置。那个信息 需要使用宏来插入构建块。

情况 1 - 模板同时包含构建块和宏

这是在文档中的插入点插入该唯一命名的构建块的宏：

Sub InsertMyBB()
'  Will not work if there are multiple building blocks with the same name in the template! See below.
'
   Dim sBBName As String
   sBBName = "MyBB"
   On Error GoTo Oops
   Application.Templates.LoadBuildingBlocks ' Thank you Timothy Rylatt!
   Application.Templates(ThisDocument.FullName).BuildingBlockEntries(sBBName).Insert _
      Where:=Selection.Range, _
      RichText:=True ' Insert MyBB Building Block
   Exit Sub ' We're done here
Oops: ' Didn't work - building block not there!
   MsgBox Prompt:="The Building Block " & sBBName & " cannot be found in " & _
      ThisDocument.Name & ".", Title:="Didn't Work!"
   On Error GoTo 0
End Sub

这个和下面的宏都包含在一个演示模板中，可以从我的下载页面下载。

情况 1a - 模板在同一模板中包含构建块和宏 - 多个具有相同名称的构建块

在这种情况下，前面的宏会混淆 Word 并给出不可预测的（对用户而言）结果。在这种情况下，宏需要 知道积木的画廊和类别。这 以下宏假设构建块存储在 自动图文集库和常规类别。你可以找到名字 使用 Building Blocks Organizer 的图库和类别。类别 名称是纯文本。画廊在 vba 中被称为建筑 块类型和使用常量。您可以找到常量列表 对于这里的不同画廊。

Sub InsertMyBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon February 2016
'
   Dim sBBName As String
   Dim sTempName As String
   Dim oBB As BuildingBlock
   sBBName = "MyBB" 'use the name of your building block instead of "MyBB"
   sTempName = ThisDocument.FullName ' puts name and full path of template in string variable
   On Error Resume Next
   Application.Templates.LoadBuildingBlocks  ' thank you Timothy Rylatt
   Set oBB = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText) _
      .Categories("General").BuildingBlocks(sBBName)
   If Err.Number = 0 Then
      oBB.Insert Selection.Range, True
   Else
      MsgBox Prompt:="The Building Block '" & sBBName & "' cannot be found in " & _
         ThisDocument.Name & ".", Title:="Didn't Work!"
   End If
   On Error GoTo 0
lbl_Exit:
   Exit Sub
End Sub

这个和前面的宏都包含在一个演示模板中，可以从我的下载页面下载。

情况 2 - 模板保存构建块位于 Word 启动文件夹中并命名为 MyBBTemplate.dotx

由于某种原因，此模板不包含宏，它位于单独的模板中。我们知道容器模板的名称。这 包含宏的模板名称对我们来说无关紧要 目的。

Sub InsertMyBB()
'  Will not work if the Startup Folder is the root directory of a drive, i.e. C:\
'  For use with building block stored in a template loaded in the Word Startup Folder that does NOT hold this macro
'  Will not work if there are multiple building blocks with the same name in the template!
'
   Dim sBBName As String
   Dim sTemplateName as String
   Dim sStartupPath as String
   sBBName = "MyBB"
   sTemplateName="MyBBTemplate.dotx"
   sStartupPath = Application.Options.DefaultFilePath(wdStartupPath)
   On Error GoTo Oops ' error handler
   Application.Templates.LoadBuildingBlocks  ' thank you Timothy Rylatt
   Application.Templates(sStartupPath & "\" & sTemplateName).BuildingBlockEntries(sBBName) _
      .Insert Where:=Selection.Range, RichText:=True ' Insert MyBB Building Block
   Exit Sub ' We're done here
Oops: ' Didn't work - building block not there!
   MsgBox Prompt:="The Building Block " & sBBName & " cannot be found in " & _
      sTemplateName".", Title:="Didn't Work!"
   On Error GoTo 0
End Sub

情况3 - 模板持有积木是积木存储位置的“Building Blocks.dotx”

此模板也不包含宏，因为 Building blocks 文件夹中的模板不会向 Word 贡献宏，即使 它们包含它们。该宏包含来自 Greg Maxey 的代码和 Jay Freedman 在此线程中给出。 Building Blocks.dotx 是 默认情况下，用于存储自定义构建块的模板 比自动图文集。它由用户以与语言相关的方式存储， 版本相关的文件夹。该宏旨在检索 构建块，无论语言或版本如何。

Sub InsertMyBB()
'  Based on code by Greg Maxey and Jay Freedman
'  For use with building block stored in the default custom building blocks file "Building Blocks.dotx"
'  Will not work if there are multiple building blocks with the same name in the template!
'
   Templates.LoadBuildingBlocks ' in case building blocks not yet accessed
   Dim sBBName As String
   Dim sStartupPath as String
   Dim sTemplateName as String
   sBBName = "MyBB"
   sTemplateName="Building Blocks.dotx"
   sStartupPath = Application.Options.DefaultFilePath(wdStartupPath)
   On Error GoTo Oops ' error handler
   Application.Templates(sStartupPath & "\" & sTemplateName).BuildingBlockEntries(sBBName) _
      .Insert Where:=Selection.Range, RichText:=True ' Insert MyBB Building Block
   Exit Sub ' We're done here
Oops: ' Didn't work - building block not there!
   MsgBox Prompt:="The Building Block " & sBBName & " cannot be found in " & _
      sTemplateName & ".", Title:="Didn't Work!"
   On Error GoTo 0
End Sub

插入积木的各种代码来自我在AutoText, Building Blocks and AutoFormat的页面。

Answer 2

宏记录器只是一个起点。您发布的示例取决于构建基块模板的一个非常具体的路径，该路径包括您的用户名和您使用的语言（1033 是美国英语）和 Word 版本（Word 2016 和 2019 的 16）。此外，构建基块模板位置没有到达它的 VBA 快捷方式。

更可靠的做法是将表格插入到您的宏模板或基于该模板的文档中。选择表格，然后选择插入>快速部件>自动图文集>将所选内容保存到自动图文集库。您可以将名称设置为您喜欢的任何名称。将图库设置为目录。 OK out，然后删除表样例。

现在您可以像这样使用更简单、更可靠的代码：

ActiveDocument.AttachedTemplate.BuildingBlockEntries("TOC1").Insert Where:=Selection.Range, RichText:=True

Answer 3

Word 不会在启动时加载 Building Block，它们是按需加载的。当您单击其中一个 Building Block 库时，您可能会注意到在显示库之前会出现短暂的停顿，即 Word 正在加载它们。

您可以通过在代码中使用 Application.Templates.LoadBuildingBlocks 安全地指示 Word 加载构建基块，如果它们已经加载，则不会生成错误。

内置Building Blocks的路径也只对你有效，但你可以通过使用Environ返回路径的第一部分来解决这个问题。

Sub InsertTOC()
   Dim path As String
   Application.Templates.LoadBuildingBlocks
   path = Environ$("USERPROFILE") & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx"
   Application.Templates(path).BuildingBlockEntries("Automatic Table 1").Insert Where:=Selection.Range, RichText:=True
End Sub