finding text wherever it appears in a word document
in [Word VBA]
|
From: Andy Fish on 27 Feb 2006 05:00 Hi, I have an application where I want to be able to find and/or replace text wherever it appears in a Word document (including in headers, footnotes etc). This is a fairly common problem and a bit of research has led me to this page: http://word.mvps.org/FAQs/Customization/ReplaceAnywhere.htm which I believe to be the current state of the art. However, this solution will not find text within a text box which is itself within a header or footer (there may be other limitations as well but this is the one I specifically came across). Does anyone know of an algorithm for search and replace which will even find text in textboxes within headers and footers? If it cannot be done from VBA or OLE at all, is there any other mechanism I can use to effect this? TIA Andy
From: Jonathan West on 27 Feb 2006 06:52 Hi Andy, Within each StoryRange as found by the ReplaceAnywhere macro, you can test for whether its ShapeRange.Count property is greater than 0. If it is, you can iterate through each Shape in the ShapeRange collection and see if its TextFrame.HasText property is True. If it is, then the Shape's TextFrame.TextRange property is a Range object which you can search for text you want to replace. -- Regards Jonathan West - Word MVP www.intelligentdocuments.co.uk Please reply to the newsgroup Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org "Andy Fish" <ajfish(a)blueyonder.co.uk> wrote in message news:u41UrS4OGHA.3888(a)TK2MSFTNGP12.phx.gbl... > Hi, > > I have an application where I want to be able to find and/or replace text > wherever it appears in a Word document (including in headers, footnotes > etc). This is a fairly common problem and a bit of research has led me to > this page: > > http://word.mvps.org/FAQs/Customization/ReplaceAnywhere.htm > > which I believe to be the current state of the art. > > However, this solution will not find text within a text box which is > itself within a header or footer (there may be other limitations as well > but this is the one I specifically came across). > > Does anyone know of an algorithm for search and replace which will even > find text in textboxes within headers and footers? > > If it cannot be done from VBA or OLE at all, is there any other mechanism > I can use to effect this? > > TIA > > Andy > >
From: Greg on 27 Feb 2006 08:16 Jonathan, I noticed that a normal find and replace also misses text in a textbox located in a header. After looking at your tip to Andy, I attempted the following which appears to be a more comprehensive "find and replace anywhere" macro. Would you please look at it an comment on where improvements could be made: Public Sub FindReplaceAnywhereWithVBA() Dim rngstory As Word.Range Dim findText As String Dim Replacement As String Dim pJunk As Long findText = "test find" Replacement = "test replaced" 'Fix the skipped blank Header/Footer problem pJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType 'Iterate through all story types in the current document For Each rngstory In ActiveDocument.StoryRanges SrchAndReplInStory rngstory, findText, Replacement On Error Resume Next If rngstory.ShapeRange.Count > 0 Then Dim oShp As Shape For Each oShp In rngstory.ShapeRange If oShp.TextFrame.HasText Then SrchAndReplInStory oShp.TextFrame.TextRange, findText, Replacement End If Next End If On Error GoTo 0 Next End Sub Public Sub SrchAndReplInStory(ByVal rngstory As Word.Range, _ ByVal strSearch As String, _ ByVal strReplace As String) Do Until (rngstory Is Nothing) With rngstory.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Replacement.Font.Color = wdColorBlue .Execute Replace:=wdReplaceAll End With Set rngstory = rngstory.NextStoryRange Loop End Sub
From: Greg on 27 Feb 2006 09:14 Jonathan (and all others) Please disregard the earlier reply. Seems that version only worked for the header/footer in first section. I have moved the addtional code in the actual search routine and it appears to work now in all headers, including headers that are not linked to a previous header: Public Sub FindReplaceWithVBA() Dim rngStory As Word.Range Dim pFindTxt As String Dim pReplaceText As String Dim lngJunk As Long pFindTxt = InputBox("Enter the text that you want to find then replace.", "Batch Replace Anywhere") If pFindTxt = "" Then MsgBox "Cancelled by User" Exit Sub End If Tryagain: pReplaceText = InputBox("Enter the pReplaceText text.", "Replace Anywhere ") If pReplaceText = "" 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 SearchAndReplaceInStory rngStory, pFindTxt, pReplaceText Next End Sub Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _ ByVal strSearch As String, _ ByVal strReplace As String) Dim oShp As Shape ResetFRParameters 'This routine supplied by Peter Hewett Do Until (rngStory Is Nothing) With rngStory.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Execute Replace:=wdReplaceAll End With On Error Resume Next If rngStory.ShapeRange.Count > 0 Then For Each oShp In rngStory.ShapeRange If oShp.TextFrame.HasText Then With oShp.TextFrame.TextRange.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Execute Replace:=wdReplaceAll End With End If Next End If On Error GoTo 0 Set rngStory = rngStory.NextStoryRange Loop End Sub
From: Greg on 27 Feb 2006 09:42
Jonathan (and others) Sorry for being troublesome. I think I have managed to make this a bit more presentable: 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 ResetFRParameters '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 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 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 .Execute Replace:=wdReplaceAll End With End Sub Sub ResetFRParameters() With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With End Sub |