Globally replace text with formatted text.

This page was prompted by a Word newsgroup question which led to a private discussion with fellow MVP Greg Maxey. The essence of the question concerned replacing a typed brand name in a document with a formatted brand name which incorporated two different fonts within the same word. This cannot be effected in a single pass by Word's replace tool. However that tool does provide for selected text to be replaced with the content of the clipboard.

It is a small step from this to place a formatted autotext entry on the clipboard and use the same function to replace this.

In the following example, I have replaced the word Lorem with an autotext smiley:

Option Explicit

Sub ReplaceWithAUTOTEXT()
'
' Replace text globally with Autotext Macro
' Macro created 21/06/2004 by Graham Mayor
' Revised 28/08/2004 with additions suggested by Greg Maxey
' Revised 01/08/2007 with modifications for Word 2007

' Revised 27/08/2007 with further modifications suggested by Greg Maxey

Dim findText As String
Dim ReplaceText As String
Dim strWildcards As String
Dim bWild As Boolean
Dim sQuery As String
Dim sType As String

Start:
findText = InputBox("Enter the text string you want to find", "Find")
If findText = "" Then
    sQuery = 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 sQuery = 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 = findText
    .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
sQuery = MsgBox("Select 'OK' to reselect the " & sType & _
" entry then click 'Insert'" & vbCr & vbCr & _
"Click 'Cancel' to exit", vbOKCancel, sType)
If sQuery = vbOK Then
    Resume GetInput
End If
End Sub