View Single Post
 
Old 01-02-2016, 10:34 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,137
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 ofgmayor has much to be proud of
Default

It would make far more sense to rename your building blocks to match the array values (or vice versa) then you can simply insert the building block that matches the name. The method you have attempted is fine if there are only two different values in the document, but if there are ten it gets rather unwieldy. You can then use code such as the following.

If you have hundreds of documents to process then you might investigate http://www.gmayor.com/document_batch_processes.htm with a custom process (or depending on what is in the building blocks, a replace from table). The following macro can easily be modified to match the format used by the add-in's custrom process option, as shown in the second panel below.

Code:
Option Explicit

Sub BuildingBlockArrayMacro()

' Replace Array Words with a Building Block - Autotext

Dim Rng As Word.Range
Dim ArrayList As Variant
Dim i As Long
    ArrayList = Array("#BB1", "#BB2")
    For i = 0 To UBound(ArrayList)
        Set Rng = ActiveDocument.Range
        With Rng.Find
            Do While .Execute(FindText:=ArrayList(i), MatchWholeWord:=True)
                Application.Templates(ActiveDocument.AttachedTemplate). _
                        BuildingBlockEntries(Rng.Text).Insert _
                        Where:=Rng, _
                        RichText:=True
                Rng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    Exit Sub
End Sub
Code:
Function BBReplace(oDoc As Document) As Boolean
Dim Rng As Word.Range
Dim ArrayList As Variant
Dim i As Long
    On Error GoTo err_Handler
    ArrayList = Array("#BB1", "#BB2")
    For i = 0 To UBound(ArrayList)
        Set Rng = oDoc.Range
        With Rng.Find
            .ClearFormatting
            Do While .Execute(FindText:=ArrayList(i), MatchWholeWord:=True)
                Application.Templates(oDoc.AttachedTemplate). _
                        BuildingBlockEntries(Rng.Text).Insert _
                        Where:=Rng, _
                        RichText:=True
                Rng.Collapse 0
            Loop
        End With
    Next i
    BBReplace = True
lbl_Exit:
    Exit Function
err_Handler:
    BBReplace = False
    GoTo lbl_Exit
End Function
__________________
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