![]() |
#5
|
|||
|
|||
![]()
Thank you for your response macropod. This code ended up working for me perfectly:
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.StoryT ype ResetFRParameters 'Iterate through all story types in the current document For Each rngStory In ActiveDocument.StoryRanges 'Iterate through all linked stories Do SrcAndRplInStory 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 SrcAndRplInStory 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 SrcAndRplInStory(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 |
Tags |
find & replace, find and replace, header and footer |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
amodiammmuneerk@glenmarkp | Word | 12 | 03-05-2018 03:31 AM |
![]() |
trillium | Word VBA | 4 | 10-20-2015 10:39 PM |
![]() |
kennethc | Word | 3 | 03-28-2015 02:49 AM |
![]() |
QA_Compliance_Advisor | Word VBA | 11 | 09-23-2014 04:40 AM |
![]() |
PReinie | Word | 6 | 01-22-2014 06:45 PM |