There are a couple of ways to do this. My VBA Find and Replace Add-In has this feature:
http://gregmaxey.com/word_tip_pages/...d_replace.html
The first macro below uses the process where the building block is inserted in a temporary document then cut to the clipboard. The clipboard content is then used as the "Replace with" and you can do a global replacement. The second macro simply inserts the builiding block at the found ranges. It assumes that your building block is in the attached template. If that isn't the case, you will have to change the code.
PHP Code:
Sub ReplaceWithAUTOTEXT()
Dim strFind As String
Dim strReplace As String
Dim strWildcards As String
Dim bWild As Boolean
Dim strQuery As String
Dim sType As String
Start:
strFind = InputBox("Enter the text string you want to find", "Find")
If strFind = "" Then
strQuery = MsgBox("You have not entered any text to find" & vbCr & _
"Or you have selected 'Cancel" & vbCr & _
"Select OK to re-try or Cancel to quit", vbOKCancel, "Find")
If strQuery = vbOK Then
GoTo Start
Else
Exit Sub
End If
End If
strWildcards = MsgBox("Use Wildcards", vbYesNo, "Find")
If strWildcards = 6 Then bWild = True Else bWild = False
GetInput:
On Error GoTo Oops 'Handle incorrect AutoText request
'Create a scratch pad
Documents.Add
If Application.Version = 12 Then
'Word 2007 - Use the Building Blocks Organizer
Dialogs(GetDialog).Show
sType = "Building Blocks" 'msgbox title
Else
'Not Word 2007 - Use the Autotext dialog.
Dialogs(wdDialogEditAutoText).Show
sType = "Autotext" 'msgbox title
End If
'Cut the inserted entry to the clipboard
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
'crumple up scratch pad :-)
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
'Replace found text with the clipboard contents.
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFind
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = bWild
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End
Oops: 'Error handler
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
strQuery = MsgBox("Select 'OK' to reselect the " & sType & _
" entry then click 'Insert'" & vbCr & vbCr & _
"Click 'Cancel' to exit", vbOKCancel, sType)
If strQuery = vbOK Then
Resume GetInput
End If
End Sub
Sub ReplaceWithAUTOTEXTII()
Dim oRng As Word.Range
Dim strFind() As String
Dim i As Long
strFind() = Split("student|your name", "|")
For i = 0 To UBound(strFind)
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFind(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While .Execute
ActiveDocument.AttachedTemplate.BuildingBlockEntries("Confidential").Insert Where:=oRng, RichText:=True
Wend
End With
Next
End Sub
12-11-2012, 01:01 PM
Similar Threads
Macro to find text and replace with form field containing that text
Windows 7 32bit 
Office 2010 (Version 14.0)
Hybrid Mode