View Single Post
 
Old 08-31-2021, 11:33 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,105
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

From my web site, the following code can be used to insert a named building block.
Code:
Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 01 Sep 2021 
Sub InsertMyBuildingBlock()
Dim oTemplate As Template
Dim oAddin As AddIn
Dim bFound As Boolean
Dim i As Long
    'Define the required building block entry
Const strBuildingBlockName As String = "Building Block Name"

    'Set the found flag default to False
    bFound = False
    'Ignore the attached template for now if the
    'document is based on the normal template
    If ActiveDocument.AttachedTemplate <> NormalTemplate Then
        Set oTemplate = ActiveDocument.AttachedTemplate
        'Check each building block entry in the attached template
        For i = 1 To oTemplate.BuildingBlockEntries.Count
            'Look for the building block name
            'and if found, insert it.
            If oTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
                oTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
                        Where:=Selection.Range
                'Set the found flag to true
                bFound = True
                'Clean up and stop looking
                Set oTemplate = Nothing
                GoTo lbl_Exit
            End If
        Next i
    End If
    'The entry has not been found
    If bFound = False Then
        For Each oAddin In AddIns
            'Check currently loaded add-ins
            If oAddin.Installed = False Then Exit For
            Set oTemplate = Templates(oAddin.path & _
                                      Application.PathSeparator & oAddin.Name)
            'Check each building block entry in the each add in
            For i = 1 To oTemplate.BuildingBlockEntries.Count
                If oTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
                    'Look for the building block name
                    'and if found, insert it.
                    oTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
                            Where:=Selection.Range
                    'Set the found flag to true
                    bFound = True
                    'Clean up and stop looking
                    Set oTemplate = Nothing
                    GoTo lbl_Exit
                End If
            Next i
        Next oAddin
    End If
    'The entry has not been found. Check the normal template
    If bFound = False Then
        For i = 1 To NormalTemplate.BuildingBlockEntries.Count
            If NormalTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
                NormalTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
                        Where:=Selection.Range
                'set the found flag to true
                bFound = True
                GoTo lbl_Exit
            End If
        Next i
    End If
    'If the entry has still not been found
    'finally check the Building Blocks.dotx template
    If bFound = False Then
        Templates.LoadBuildingBlocks
        For Each oTemplate In Templates
            If oTemplate.Name = "Building Blocks.dotx" Then Exit For
        Next
        For i = 1 To Templates(oTemplate.FullName).BuildingBlockEntries.Count
            If Templates(oTemplate.FullName).BuildingBlockEntries(i).Name = strBuildingBlockName Then
                Templates(oTemplate.FullName).BuildingBlockEntries(strBuildingBlockName).Insert _
                        Where:=Selection.Range
                'set the found flag to true
                bFound = True
                'Clean up and stop looking
                Set oTemplate = Nothing
                GoTo lbl_Exit
            End If
        Next i
    End If
    'All sources have been checked and the entry is still not found
    If bFound = False Then
        'so tell the user.
        MsgBox "Entry not found", _
               vbInformation, _
               "Building Block " _
               & Chr(145) & strBuildingBlockName & Chr(146)
    End If
lbl_Exit:
    Set oTemplate = Nothing
    Set oAddin = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote