VBA using Building Blocks to build document

[kintap]

Hi,



I have a VBA routine that does build a document we use at work. What I am wondering is there a way to clean it up and make it shorter, easier to edit.

This is what I have already (and it works):

Sub par()
Dim objTemplate As Template
Dim objBB As BuildingBlock

' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate

' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("PHN Box")
' Insert the building block into the document replacing any selected text.
objBB.Insert ActiveDocument.Bookmarks("PHNBox").Range


' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Internal AHS")
' Insert the building block into the document replacing any selected text.
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Disclaimer")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Opening")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Identifying")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Presenting")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Risk Factors")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Mental Status/Vegetative")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Pertinent History")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Clinical Impressions")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Client Goals")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Therapeutic Plan")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line Wide")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Copy of Assessment")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line Wide")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Next Appointment")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Safety")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Blank Line Wide")
objBB.Insert Selection.Range

Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("Initials")
objBB.Insert Selection.Range




Application.ScreenUpdating = False

With ActiveDocument
  .Bookmarks("HeaderTitle").Range.Text = "Mental Health Assessment"
Application.ScreenUpdating = True

End With

End Sub

What I am hoping for is a way to set a variable for the build blocks index (ie. BuildingBlocks("THIS PART HERE"))

so that I could write the code more like

Dim objTemplate As Template
Dim objBB As BuildingBlock
Dim BBvar as *SOMETHING*

' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("BBvar")

BBvar = "PHN Box"
' Insert the building block into the document replacing any selected text.
objBB.Insert ActiveDocument.Bookmarks("PHNBox").Range


BBvar = "Internal AHS"
objBB.Insert Selection.Range

BBvar = "Blank Line"
objBB.Insert Selection.Range

is this even possible? or is there another way to do this.

Thank you for your help.

Kyle

[gmaxey]

Maybe something like:

Dim objTemplate As Template
Dim objBB As BuildingBlock
Dim arrBBNames() As String
Dim lngIndex As Long
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
.Categories("General").BuildingBlocks("PHN Box")
' Insert the building block into the document replacing any selected text.
objBB.Insert ActiveDocument.Bookmarks("PHNBox").Range
arrBBNames = Split("Internal AHS,Disclaimer,Blank Line,etc.", ",")
For lngIndex = 0 To UBound(arrBBNames)
  Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom1) _
              .Categories("General").BuildingBlocks(arrBBNames(lngIndex))
  objBB.Insert Selection.Range
Next lngIndex

But why don't you just create a template with all of this content and start your documents based on the template?

[kintap]

Hi Greg,

Thank you very much that works perfectly. I have been learning a lot on this forum.

The reason that we do this is that we have multiple documents that use common portions. I integrated all the documents (7 in total) into one file that has a userform popup that creates the document. This allows us to make a change once (to the building block) and it is updated across all the documents that share that component. It also allows us to add/remove components or make changes quickly, and we only have one file that employees here need to have a shortcut to.

Kyle