 |
|
|
|
 |
Using
a macro to replace text where ever it appears in a document
|
A collaborative effort of MVP’s
Doug Robbins and
Greg Maxey
with enhancements by Peter Hewett and
Jonathan West
Using the Find or Replace utility on the Edit menu you can
find or replace text "almost" anywhere it appears in the document. If you record
that action however, the scope or "range" of the resulting recorded macro will
only act on the text contained in the body of the document (or more accurately,
it will only act on the part of the document that contains the insertion point).
This means that if the insertion point is located in the main body of the
document when your macro is executed it will have no effect on text that is in
the headers or footers of the document, for example, or in a textbox, footnotes,
or any other area that is outside the main body of the document.
Even the Find and Replace utility has a shortcoming. For
example, text in a textbox located in a header or footer is outside the scope of
the Find and Replace utility search range.
Both issues are well worth sending an email to
mswish@microsoft.com.
To use a macro to find or replace text anywhere in a
document, it is necessary to loop through each individual part of the document.
In VBA, these parts are called StoryRanges. Each StoryRange is identified by a
unique wdStoryType constant.
There are eleven different wdStoryType constants that can
form the StoryRanges (or parts) of a document (ok, a few more in later versions
of Word, but they have no bearing in this discussion). Simple documents may
contain only one or two StoryRanges, while more complex documents may contain
more. The wdStoryTypes that have a role in find and replace are:
wdCommentsStory,
wdEndnotesStory, wdEvenPagesFooterStory, wdEvenPagesHeaderStory,
wdFirstPageFooterStory, wdFirstPageHeaderStory, wdFootnotesStory,
wdMainTextStory, wdPrimaryFooterStory, wdPrimaryHeaderStory, and
wdTextFrameStory.
The complete code to find or replace text anywhere is a
bit complex. Accordingly, let’s take it a step at a time to better illustrate
the process. In many cases the simpler code is sufficient for getting the job
done.
Step 1
The following code loops through each
StoryRange in the active document and replaces the specified .Text with .Replacement.Text:
Sub
FindAndReplaceFirstStoryOfEachType()
Dim
rngStory
As
Range
For Each
rngStory In ActiveDocument.StoryRanges
With
rngStory.Find
.Text =
"find text"
.Replacement.Text =
"I'm found"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next
rngStory
End Sub
(Note for those already familiar with
VBA: whereas if you use Selection.Find, you have to specify all of the Find and
Replace parameters, such as .Forward = True, because the settings are otherwise
taken from the Find and Replace dialog's current settings, which are “sticky”,
this is not necessary if using [Range].Find – where the parameters use their
default values if you don't specify their values in your code).
The simple macro above has shortcomings.
It only acts on the "first" StoryRange of each of the eleven StoryTypes (i.e.,
the first header, the first textbox, and so on). While a document only has one
wdMainTextStory StoryRange, it can have multiple StoryRanges in some of the
other StoryTypes. If, for example, the document contains sections with un-linked
headers and footers, or if it contains multiple textboxes, there will be
multiple StoryRanges for those StoryTypes and the code will not act upon the
second and subsequent StoryRanges. To even further complicate matters, if your
document contains unlinked headers or footers and one of the headers or footers
are empty then VBA can have trouble "jumping" that empty header or footer and
process subsequent headers and footers.
Step 2
To make sure that the code acts on every StoryRange in each each StoryType,
you need to:
- Make use of the NextStoryRange method
- Employ a bit of VBA "trickery" as provided by Peter Hewett to bridge any
empty unlinked headers and footers.
Public Sub
FindReplaceAlmostAnywhere()
Dim
rngStory
As
Word.Range
Dim
lngJunk
As Long
'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
lngJunk = ActiveDocument.Sections(
1
).Headers(
1
).Range.StoryType
'Iterate through all story types in the current document
For Each
rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
With
rngStory.Find
.Text =
"find text"
.Replacement.Text =
"I'm found"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
'Get next linked story (if any)
Set
rngStory = rngStory.NextStoryRange
Loop Until
rngStory
Is Nothing
Next
End Sub
There is one remaining problem. Just
like with the Find and Replace utility, the code above can miss any text that is
contained in one StoryType/StoryRange nested in a different StoryType/StoryRange.
While this problem does not occur with a nested StoryType/StoryRange in the
wdMainTextStory StoryRange, it does occur in header and footer type StoryRanges.
An example is textbox that is located in a header or footer.
Step 3
Fortunately Jonathan West provided a
work around for the problem of such nested StoryRanges. The work around makes
use of the fact that Textboxes and other Drawing Shapes are contained in a
document’s ShapeRange collection. We can therefore check the ShapeRange in each
of the six header and footer StoryRanges for the presence of Shapes. If a Shape
is found, we then check each Shape for the presence of the text, and finally, if
the Shape contains text we set our search range to that Shape's .TextFrame.TextRange.
This final macro contains all of the
code to find and replace text “anywhere” in a document. A few enhancements have
been added to make it easier to apply the desired find and replace text strings.
Note: It is
important to convert the code text to plain text before you paste: if you paste
directly from a web browser, spaces are encoded as non-breaking spaces, which
are not "spaces" to VBA and will cause compile- or run-time errors.
Also: Be careful of the long lines in this code. When you paste this code
into the VBA Editor, there should be NO red visible anywhere in what you pasted.
If there is, try carefully joining the top red line with the one below it
(without deleting any visible characters.
Public Sub
FindReplaceAnywhere()
Dim
rngStory
As
Word.Range
Dim
pFindTxt
As String
Dim
pReplaceTxt
As String
Dim
lngJunk
As Long
Dim
oShp
As
Shape
pFindTxt = InputBox( "Enter the text that you want to find."
_
,
"FIND"
)
If
pFindTxt =
""
Then
MsgBox
"Cancelled by User"
Exit Sub
End If
TryAgain:
pReplaceTxt = InputBox(
"Enter the replacement."
,
"REPLACE"
)
If
pReplaceTxt =
""
Then
If
MsgBox(
"Do you just want to delete the found text?",
_
vbYesNoCancel) = vbNo
Then
GoTo
TryAgain
ElseIf
vbCancel
Then
MsgBox
"Cancelled by User."
Exit Sub
End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(
1
).Headers(
1
).Range.StoryType
'Iterate through all story types in the current document
For Each
rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case
rngStory.StoryType
Case
6
,
7
,
8
,
9
,
10
,
11
If
rngStory.ShapeRange.Count >
0
Then
For Each
oShp In rngStory.ShapeRange
If
oShp.TextFrame.HasText
Then
SearchAndReplaceInStory oShp.TextFrame.TextRange, _
pFindTxt, pReplaceTxt
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo
0
'Get next linked story (if any)
Set
rngStory = rngStory.NextStoryRange
Loop Until
rngStory
Is Nothing
Next
End Sub
Public Sub
SearchAndReplaceInStory(ByVal
rngStory
As
Word.Range,
_
ByVal
strSearch
As String
,
ByVal
strReplace
As String
)
With
rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End Sub
All of the above macros can be applied
using:
Create a Macro
|





|