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

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