VBA Find&Replace all bold, itlaic, underlined and highlighted words/characters

macropod · #20 04-16-2018, 03:00 PM

Your addition of:
(?@>)
to the first macro is unlikely to help; indeed it will produce masses of extra tags. If you're getting spurious tags somewhere, that's because you have spurious formatting in those locations.

It's also not the code I posted that is creating any capitalised tags. The only way I can envisage that happening is if you have existing content formatted with a Style using the 'All Caps' or 'Small Caps' attribute. As for adding:
.MatchCase = False
to the second macro, that won't work because it's doing a wildcard Find. Try:

Code:

Sub aabFettKursivQuelldok()
Application.ScreenUpdating = False
With ActiveDocument
  .AutoHyphenation = False
  With .Range
    .ListFormat.ConvertNumbersToText
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = True
      .Forward = True
      .MatchWildcards = True
      .Wrap = wdFindContinue
      .Font.Underline = True
      .Text = ""
      .Replacement.Text = "<u>^&</u>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Highlight = True
      .Replacement.Text = "<h>^&</h>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Font.Bold = True
      .Replacement.Text = "<b>^&</b>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Font.Italic = True
      .Replacement.Text = "<i>^&</i>"
      .Execute Replace:=wdReplaceAll
    End With
    .Style = wdStyleNormal
    .Font.Reset
    .HighlightColorIndex = wdNoHighlight
  End With
End With
Application.ScreenUpdating = True
End Sub

Code:

Sub aabFettKursivZieldok()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = True
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Replacement.Text = "\1"
  .Text = "\<[Uu]\>(*)\</[Uu]\>"
  .Replacement.Font.Underline = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Hh]\>(*)\</[Hh]\>"
  .Replacement.Highlight = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Bb]\>(*)\</[Bb]\>"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Ii]\>(*)\</[Ii]\>"
  .Replacement.Font.Italic = True
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to find and replace headings in bold and underline	redzan	Word VBA	4	02-13-2016 12:24 PM
Find, select, and replace part of text with bold	paik1002	Word VBA	4	12-07-2015 11:24 PM
Find and Replace some characters with Bullets	kjxavier	Word	1	01-02-2015 12:15 AM
Find/Replace Wildcard Needed-Bold & Highlight	rsrasc	Word VBA	3	11-11-2014 03:55 PM
find and replace in bold	redzan	Word VBA	1	07-27-2014 03:35 PM