VB MSWord-Find and Replace formatting in "stories"

[vGetdown]

Hey nice forum, you are dominating google search results.

So I want to search through a word document that contains specified text strings and when it finds the string, I want it to change the formatting like bold, color, underline.

I recorded the macro and it gave me the code which works in a macro as long as I do not search inside text boxes. The documents which will be used by this macro primarily contains tables and text boxes and so that is a problem. I found a big workaround to make the find and replace macro work in the text boxes, and it does succesfully replace the text itself as I want, and also the cAsE which I need.

This workaround does not appear to be letting me change the bold, underline, italic or highlighting of the text it finds. I put the code for these additional effects right next to the code which does totally work, and it acts like it is not there.


Here is what it records when I find and replace and change the formatting like how I want, and this works when I don't need to look inside a "story" which is what they call text boxes, headers footers and whatever probably some other objects in a word doc:

Sub fandrformat()
'
' fandrformat Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find.Replacement.Font
        .Bold = True
        .Italic = True
        .Underline = wdUnderlineThick
        .Color = 49407
    End With
    With Selection.Find
        .text = "thingtofind"
        .Replacement.text = "thingtoreplace"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Here is the whole code I needed to use in order to get the macroed find and replace function to work inside text boxes. There is actually a UserForm for folks to record a list of items to find and replace then save that list to a text file to be reloaded later. So there is some code in here to parse that list. I don't know if it's relevant that this entire thing is located inside a For loop for that purpose, so I have included it.

Private Sub GoButton_Click()
Dim countlinesfor As Integer
countlinesfor = Len(TextBoxBottomLeft.Text) - Len(Replace(TextBoxBottomLeft.Text, Chr(10), ""))
Dim i As Integer
Dim textIn As String
Dim textOut As String
Dim startPositionRight As Integer
Dim startPositionleft As Integer
TextBoxTest.Text = ""

For i = 1 To countlinesfor
    
                startPositionleft = InStr(TextBoxBottomLeft.Text, CStr(i) + ". ")
                startPositionRight = InStr(TextBoxBottomRight.Text, CStr(i) + ". ")
                
                ''''Critical step
                textIn = Mid(TextBoxBottomLeft.Text, startPositionleft + 3, InStr(startPositionleft, TextBoxBottomLeft.Text, Chr(10)) - (startPositionleft + 4))
                TextBoxTest.Text = TextBoxTest.Text + textIn + Chr(10)
                'TextBoxTest.Text = TextBoxTest.Text + CStr(i)
                
                ''''Critical step
                textOut = Mid(TextBoxBottomRight.Text, startPositionRight + 3, InStr(startPositionRight, TextBoxBottomRight.Text, Chr(10)) - (startPositionRight + 4))
                TextBoxTest.Text = TextBoxTest.Text + textOut + Chr(10)
anotherSubFunction textIn, textOut
Next i

End Sub

________________________________________________________________________________
Public Sub anotherSubFunction(ByVal txtin As String, ByVal txtout As String)
 
    
    
  Dim rngStory As Word.Range
  Dim lngJunk As Long
  Dim oShp As Shape
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, txtin, txtout
      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, txtin, txtout
            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)
    rngStory.find.ClearFormatting
    rngStory.find.Replacement.ClearFormatting

'''STARTING HERE this code DOES NOT do anything

    rngStory.find.Replacement.Highlight = True
    With rngStory.find.Replacement.Font
        .Bold = True
        .Italic = True
        .Underline = wdUnderlineThick
        .Color = 49407
    End With

'''AFTER HERE the code is fine

  With rngStory.find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strSearch
    
    .Replacement.Text = strReplace
    .Wrap = wdFindContinue
    .MatchCase = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll

  End With
 

End Sub

It all works except for that third function there, "SearchandReplaceinStory" will not change the bold, underline, italics or highlighting like I want it to. I first created the whole thing without this last bit of code copied below, and it all worked, found and replaced, and it still works after I added this code. It just acts like this code has not been put in there. The macro recorder said "Selection" instead of "rngStory" so I switched that one part to hopefully make it fit here.

    rngStory.find.Replacement.Highlight = True
    With rngStory.find.Replacement.Font
        .Bold = True
        .Italic = True
        .Underline = wdUnderlineThick
        .Color = 49407
    End With

The goal here, again, is to take a text file, bring it into the macro, find and replace inside text boxes in the word doc, and change it to bold, underline, italic or highlighted (I will hopefully be able to use bools and togglebuttons to make this optional). Every part of that is finished except the formatting.


Thanks heroes!