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

Kalü · #16 04-16-2018, 05:23 AM

No you misunderstood me:
in my first attachments the document were the original documents after running the frist macro.

The attachent from today is a new doument that i get AFTER pasting the tagged text in a new document and run the second macro...

macropod · #17 04-16-2018, 05:26 AM

And when did you remove the automatic numbering??? It's present in post #9 and missing from post #13! Obviously, if you did that between running the two macros, the formatting will be off because the numbers will now be affected by where they appear in relating to the tagging (or absence thereof).

Kalü · #18 04-16-2018, 05:37 AM

The automatic numbering gets removed when i paste the text with the option "keep text only". But this essential for me to do since it is the only reason I wrote the macro (to keep bold/italic/underlined/highlighted text after pasting with "keep text only").....

Do you see any possibility to use your new macros? And why is it working with the old one better than with the new? I cant really understand

Kalü · #19 04-16-2018, 06:34 AM

Ok, I found a simple option to turn off auto numbering in the first macro. That should troubleshoot the problem you described above shouldn't it?

And I also found out that the macro is working way better when I write .Text = "(?@>)" instead of .Text = ""
Because now i dont have whole pages formatted bold or italic.

The only Problem left now is that the second macro does not find and replace words that are tagged with capitalized tags like <B>.
(I actually dont know why the first macro is giving out some capitalized tags, but I think that must be the styles/formatting of the old documents).
I tried to add .MatchCase = False to the second macro, but it makes no difference.

I really overreached my knowledge cap right now and ranning out of ideas... would be so great if you could help me!

The current to macros look like the following (I marked the passages red that I recently added on my own):

Code:

Sub aaaaaQuelldok()
' hyphenation off
ActiveDocument.AutoHyphenation = False
' auto numbering off
ActiveDocument.Range.ListFormat.ConvertNumbersToText
'tag all formatted words
Application.ScreenUpdating = False
With ActiveDocument.Range.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
Application.ScreenUpdating = True
End Sub

Code:

Sub aaaaaZieldok()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = True
  .Forward = True
  .MatchWildcards = True
.MatchCase = False
  .Wrap = wdFindContinue
  .Replacement.Text = "\1"
  .Text = "\<u\>(*)\</u\>"
  .Replacement.Font.Underline = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<h\>(*)\</h\>"
  .Replacement.Highlight = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<b\>(*)\</b\>"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<i\>(*)\</i\>"
  .Replacement.Font.Italic = True
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

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

Kalü · #21 04-17-2018, 05:47 AM

Dear Paul,

Thank you very much!

It seems to work perfectly for now!

I have modified the macros so that the first macro is also copying all text and the second macro is pasting plain text. For that I recorded a macro and copied the expressions (red marked in the code below). Did I right, or is there room for any improvements? Or is there any reason to not integrate the copy&paste functions in my macros?
(Background for this adjustment is that I would like my colleagues to use the macros and they are beginners. And with that adjustment they just have to click on the macro and thats it.)

I have one more question to this adjustment: Is there the possiblity that the second macro is pasting the styles from the old document? I come to this conclusion because when I copy text and then in the new document press Ctrl. + V and chose in the pasting options that appear at the end of the text "keep text only" it sometimes keeps the styles from the old document. This is not happening when i dont press Ctrl. + V but simply rightclick and choose "keep text only".
And I have no idea what way of pasting the macro is going.

Sorry for my English! I really try to give my best and I hope you can understand what I mean

Code:

Sub aaaabTEEESTFettKursivQuelldok()
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
   Selection.WholeStory
   Selection.Copy
End Sub

Code:

Sub aaaabFettKursivZieldok()
   Selection.PasteAndFormat (wdFormatPlainText)
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

macropod · #22 04-17-2018, 03:33 PM

If you just do a plain copy/paste, any Styles applied to the copied range will be pasted to the destination document. However, since the code I posted eliminates all Style information (except for keeping the basic Normal Style), that shouldn't be an issue. In any event, using the 'keep text only' paste option will not transfer any Style information.

For the copying, all you need do is insert:
.Copy
after:
.HighlightColorIndex = wdNoHighlight

For the pasting, all you need do is insert:
ActiveDocument.Range.Paste
after:
Application.ScreenUpdating = False

Kalü · #23 04-24-2018, 05:35 AM

Thank you very much!

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