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