Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Word / Programming / February 2005

Tip: Looking for answers? Try searching our database.

Multiple-Search/Replace also in Footnotes

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Ralf999 - 10 Feb 2005 10:34 GMT
I am using a macro that helps very good to search and replace multiple
words. The information which word to replace with wich other word is
taken from another file (sr.doc). But the search/replace function only
works for the text-body and not for the footnotes. Can anybody tell me
how to modify the vba below to include the footnotes in the
search/replace macro?

Sub MultiSuchenErsetzen()
'
'
'
'
Dim WordList As Document
Dim Source As Document
Dim i As Integer
Dim Find As Range
Dim Replace As Range
Set Source = ActiveDocument
Set WordList = Documents.Open(FileName:="C:\SR.doc")
Source.Activate

For i = 2 To WordList.Tables(1).Rows.Count
   Set Find = WordList.Tables(1).Cell(i, 1).Range
   Find.End = Find.End - 1
   Set Replace = WordList.Tables(1).Cell(i, 2).Range
   Replace.End = Replace.End - 1
   Selection.HomeKey Unit:=wdStory
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
       .Text = Find
       .Replacement.Text = Replace
       .Forward = True
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = True
       .MatchByte = False
       .CorrectHangulEndings = True
       .MatchAllWordForms = False
       .MatchSoundsLike = False
       .MatchWildcards = False
       .MatchFuzzy = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
Next i
Greg Maxey - 10 Feb 2005 11:11 GMT
Ralf999,

The following is a mult-ifile multi-word find and replace anywhere macro.
You should be able to extract the code you need from here:

Public Sub BatchFileMultiFindAndReplace()

'This macro is a collection of work by Doug Robbins, Peter Hewett, Klaus
Linke, Graham Mayor and and a little bit by me, Greg Maxey

Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim ListArray
Dim WordList As Document

'Close any documents that may be open
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
' Change the path and filename in the following to suit where you have your
list of words
Set WordList = Documents.Open(FileName:="D:\My Documents\Word\Word
Documents\Word Tips\Find and Replace List.doc")
ListArray = WordList.Tables(1).Range.Text
ListArray = Split(ListArray, Chr(13) & Chr(7))
WordList.Close
' Get the folder containing the files
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With

If Left(PathToUse, 1) = Chr(34) Then
PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
End If

myFile = Dir$(PathToUse & "*.*")

While myFile <> ""
'Open each file and make the replacement
Set myDoc = Documents.Open(PathToUse & myFile)
'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
'Close the file, saving the changes.
myDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend

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

Dim Source As Document
Dim i As Integer
Dim Find As Range
Dim Replace As Range
Set Source = ActiveDocument
Source.Activate
For i = LBound(ListArray) To UBound(ListArray) - 1 Step 3
 With rngstory.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = ListArray(i)
   .Replacement.Text = ListArray(i + 1)
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next i
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.StoryType
End Sub.

Signature

Greg Maxey/Word MVP
A Peer in Peer to Peer Support

> I am using a macro that helps very good to search and replace multiple
> words. The information which word to replace with wich other word is
[quoted text clipped - 42 lines]
>    Selection.Find.Execute Replace:=wdReplaceAll
> Next i
Ralf999 - 10 Feb 2005 12:48 GMT
Dear Sirs,

I tried both of your proposed methods but I guess I am not skilled
enough to implement it...

Greg: I used your VBA. For the information to be searched and replaced,

I have a word-file, which contains a table with the expression in the
left column to search and the expression (with spaces between) to
replace with. But he is not reading the information. Do I need to
organize it in a different way?

Doug: Thank you for the link. I read it but how can I make him replace
multiple expressions with other expression?

I am very grateful that you help me guys!

Thanks,

Ralf
Doug Robbins - 10 Feb 2005 11:16 GMT
See the article "Using a macro to replace text where ever it appears in a
document

including Headers, Footers, Textboxes, etc." at:

http://word.mvps.org/FAQs/Customization/ReplaceAnywhere.htm

Signature

Please respond to the Newsgroup for the benefit of others who may be
interested.   Questions sent directly to me will only be answered on a paid
consulting basis.

Hope this helps,
Doug Robbins - Word MVP

>I am using a macro that helps very good to search and replace multiple
> words. The information which word to replace with wich other word is
[quoted text clipped - 42 lines]
>    Selection.Find.Execute Replace:=wdReplaceAll
> Next i
Ralf999 - 10 Feb 2005 11:56 GMT
Dear Sirs,

I tried both of your proposed methods but I guess I am not skilled
enough to implement it...

Greg: I used your VBA. For the information to be searched and replaced,
I have a word-file, which contains a table with the expression in the
left column to search and the expression (with spaces between) to
replace with. But he is not reading the information. Do I need to
organize it in a different way?

Doug: Thank you for the link. I read it but how can I make him replace
multiple expressions with other expression?

I am very grateful that you help me guys!

Thanks,

Ralf
Ralf999 - 10 Feb 2005 11:58 GMT
Dear Sirs,

I tried both of your proposed methods but I guess I am not skilled
enough to implement it...

Greg: I used your VBA. For the information to be searched and replaced,
I have a word-file, which contains a table with the expression in the
left column to search and the expression (with spaces between) to
replace with. But he is not reading the information. Do I need to
organize it in a different way?

Doug: Thank you for the link. I read it but how can I make him replace
multiple expressions with other expression?

I am very grateful that you help me guys!

Thanks,

Ralf
Greg - 10 Feb 2005 13:04 GMT
Ralf999,

You need a two column table.  The find text in the left and the replace
text in the right.  Set the location and name of the file containing
your list in the macro, e.g.,
Set WordList = Documents.Open(fileName:="C:\Find and Replace List.doc")

Here the macro stripped down to just a single file multiword Find and
Replace.

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 List.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
'This routine supplied by Peter Hewett
For i = LBound(ListArray) To UBound(ListArray) - 1 Step 3
 With rngstory.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = ListArray(i)
   .Replacement.Text = ListArray(i + 1)
   .Execute Replace:=wdReplaceAll
 End With
Next i
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.StoryType
End Sub
Sub ResetFRParameters()

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

End Sub
Ralf999 - 10 Feb 2005 13:56 GMT
Thx Greg,

but he still brings an error in this line:

ListArray = Split(ListArray, Chr(13) & Chr(7))

He marks Chr(13) that he has a problem with it.....Is the length of my
strings relevant?

Thank you very much,

Ralf
Greg - 10 Feb 2005 14:44 GMT
Ralf,

I just copied the code back to a new clean document and it works fine
here.  Are you using a two column table for the source of your Find and
Replace strings.  The Find strings need to be in the left column and
the Replace strings in the Right column.  Put "Find" in the first row
and "Replace" in the second.

Yes the strings cannot be > 255 characters for this application
Ralf999 - 10 Feb 2005 14:56 GMT
Greg,

I am doing exactly what you say!

Can it be that I am missing a library (dll or anything like this) that
is needed to use the CHR command?
Ralf999 - 10 Feb 2005 15:15 GMT
I added some libraries (by chance)....and this line finally worked....

now he stops at:
For i = LBound(ListArray) To UBound(ListArray) - 1 Step 3

telling me: type missmatch (error 13)
Ralf999 - 10 Feb 2005 16:49 GMT
Hey Greg,

I finally made it....I reduced the numbers of subs....and it finally
works!

Perfect!!!

Thank you so much! This helps me to save an enormous amount of time!

Ralf

P.S.: here again the final code I used:

Public Sub MultiWordFindReplace()

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

Set WordList = Documents.Open(FileName:="C:\SR.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
   With Selection.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .Text = ""
     .Replacement.Text = ""
     .Forward = True
     .Wrap = wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = True
     .MatchWildcards = False
     .MatchSoundsLike = False
     .MatchAllWordForms = False
   End With
   For i = LBound(ListArray) To UBound(ListArray) - 1 Step 3
     With rngstory.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = ListArray(i)
       .Replacement.Text = ListArray(i + 1)
       .MatchWholeWord = True
       .Execute Replace:=wdReplaceAll
     End With
   Next i

   Set rngstory = rngstory.NextStoryRange
 Loop Until rngstory Is Nothing
Next

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.StoryType
End Sub
Greg Maxey - 10 Feb 2005 20:28 GMT
Glad it works and helps.  I don't know why it wouldn't work for you as it
was.

Signature

Greg Maxey/Word MVP
A Peer in Peer to Peer Support

> Hey Greg,
>
[quoted text clipped - 63 lines]
> lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
> End Sub
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.