View Single Post
  #4   Report Post  
markymids
 
Posts: n/a
Default

Thank you for the quick response Greg

Unfortunately the array would need to be from within the document - and it
would not be possible to link to an external document. The definitions are
specific on a per document basis (ie different words are defined in different
documents).

Could the multiword find and replace code not be adapted so as to look for
defined words within say a bookmarked section of text within the document
itself?

"Greg" wrote:

markymids,

I have adapted a multiword find and replace macro that might suit your
needs. You will need to define a list of words in a single column
table with a the heading "Find" then run the macro:

Option Explicit
Public Sub MultiWordFindReplace()

Dim rngstory As Word.Range
Dim ListArray
Dim WordList As Document

' Change the path and filename in the following to suit where you have
your list of words
Set WordList = Documents.Open(FileName:="C:\Find and Replace
List1.doc")
ListArray = WordList.Tables(1).Range.Text
ListArray = Split(ListArray, Chr(13) & Chr(7))
WordList.Close

'Fix the skipped blank Header/Footer problem
MakeHFValid
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngstory, ListArray
' 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, ByRef
ListArray As Variant)
'This routine supplied by Peter Hewett and modified by Greg Maxey
ResetFRParameters
Dim i As Long
Dim j As Long
Dim myString As String
'This routine supplied by Peter Hewett
'For i = LBound(ListArray) To UBound(ListArray) - 1 Step 2
For i = 2 To UBound(ListArray) - 1 Step 2
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ListArray(i)
On Error GoTo Done
.Replacement.Text = Format(Left(ListArray(i), 1), "") &
Right(ListArray(i), Len(ListArray(i)) - 1)
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
End With
Next i
Done:
End Sub
Public Sub MakeHFValid()
'And this too
Dim lngJunk As Long
' It does not matter whether we access the Headers or Footers property.
' The critical part is accessing the stories range object
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryT ype
End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

End Sub

Note. I am not too sure of the error handler. If anyone else can
improve on that or any other part of this code I would be interested.