VBA using Building Blocks to build document

kintap · #1 07-11-2014, 08:47 AM

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):

Code:

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

Code:

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 · #2 07-11-2014, 10:12 AM

Maybe something like:

Code:

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 · #3 07-11-2014, 10:56 AM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Sharing Building Blocks	dricciuti	Word	0	11-03-2013 03:40 PM
Building blocks show correctly in dropdown, but wrong building block populates in doc	wordgirl123	Word	0	10-03-2013 08:30 AM
Building Blocks Organizer	Neece	Office	0	08-06-2011 05:14 AM
Building Blocks - WHY???	namedujour	Word	5	05-03-2011 01:37 PM
Building blocks in 2007	derohanes	Office	6	03-05-2011 01:31 PM