|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
VBA Find&Replace all bold, itlaic, underlined and highlighted words/characters
Hi,
I wrote a macro that finds and replace ("marks") all bold, itlaic, underlined and highlighted words in a document. It "marks" the wirds by setting a specific characters before and after the word, so Word will find the words again, when i copy and paste in a new document with pasting "Text only". I am very sad because it is just not working 100% also i spent so many hours to get it working....
Can anybody find the error(s) in my VBA-code? Sub aabFettKursivQuelldok() ' ' aaFettKursivQuelldok Macro ' ' ' marks all highlighted words Selection.Find.ClearFormatting Selection.Find.Font.Underline = wdUnderlineSingle Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "(?@>)" .Replacement.Text = "°°°°^&''''" .Forward = True .Wrap = wdFindAsk .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' marks all underlined words Selection.Find.ClearFormatting Selection.Find.Highlight = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "(?@>)" .Replacement.Text = "§§§^&%%%%" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' marks all bold words Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "(?@>)" .Replacement.Text = "####^&&&&&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' marks all italic words Selection.Find.ClearFormatting Selection.Find.Font.Italic = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "(?@>)" .Replacement.Text = "~~^&+++" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub Sub aabFettKursivZieldok() ' ' aaFettKursivZieldok Macro ' ' replaces all underlined-marked words Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Underline = wdUnderlineSingle With Selection.Find .Text = "°°°°(?@>)''''" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' replaces all highlighted-marked words Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Highlight = True With Selection.Find .Text = "§§§(?@>)%%%%" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' replaces all bold-marked words Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Bold = True With Selection.Find .Text = "####(?@>)&&&&" .Replacement.Text = "^&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' replaces all italic-marked words Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Italic = True With Selection.Find .Text = "~~(?@>)+++" .Replacement.Text = "^&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll ' deletes all marks: Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "°°°°" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "''''" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "§§§" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "%%%%" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "####" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "&&&&" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "~~" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "+++" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub |
#2
|
||||
|
||||
Quote:
.Wrap = wdFindAsk in one place instead of: .Wrap = wdFindContinue Quote:
That said, your code's efficiency could be greatly improved. For your first macro, try: Code:
Sub aabFettKursivQuelldok() Application.ScreenUpdating = False With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Format = True .Forward = True .MatchWildcards = True .Wrap = wdFindContinue .Font.Underline = True .Text = "(?@>)" .Replacement.Text = "°°°°^&''''" .Execute Replace:=wdReplaceAll .ClearFormatting .Highlight = True .Replacement.Text = "§§§^&%%%%" .Execute Replace:=wdReplaceAll .ClearFormatting .Font.Bold = True .Replacement.Text = "####^&&&&&" .Execute Replace:=wdReplaceAll .ClearFormatting .Font.Italic = True .Replacement.Text = "~~^&+++" .Execute Replace:=wdReplaceAll End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Cross-posted at: http://www.vbaexpress.com/forum/show...find-the-Error
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Wow thank you very much, that looks great!!!
The second macro cannot be done in your style because the find what text differs for bold, italic, underlined and highlighted - right? Quote:
https://imgur.com/a/ovLAC I have no idea why it is doing this And I have an additional question: Is it possible to turn off hyphenation in the document by using a vba-command and integrate this command in the first macro? Thank you very very much for your help and sorr im such a nooooob |
#5
|
|||
|
|||
And sorry for "crossposting" but I didnt know that these two forums belong together (
|
#6
|
||||
|
||||
Quote:
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 = "°°°°(?@>)''''" .Replacement.Font.Underline = True .Execute Replace:=wdReplaceAll .Replacement.ClearFormatting .Text = "§§§(?@>)%%%%" .Replacement.Highlight = True .Execute Replace:=wdReplaceAll .Replacement.ClearFormatting .Text = "####(?@>)&&&&" .Replacement.Font.Bold = True .Execute Replace:=wdReplaceAll .Replacement.ClearFormatting .Text = "~~(?@>)+++" .Replacement.Font.Italic = True .Execute Replace:=wdReplaceAll End With Application.ScreenUpdating = True End Sub Quote:
Quote:
ActiveDocument.AutoHyphenation = False
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
First of all: Thank you really very much you are helping me a lot!! And wow.. Wish I had more know-how.. Is there any tutorial you can advice me for getting more into vba-macros?
Quote:
Strange thing is : it is actually working, just the bold, italic AND highlighted words seem to cause this error. Maybe my "marks" are too long or bad-choosen so that tthey come in conflict when they are next to each other? But i tried it with othe marks and it wasnt working neither... I just cant get whats te problem.. |
#8
|
||||
|
||||
I am unable to replicate the behaviour you describe. Perhaps you could attach the actual document exhibiting the behaviour to a post (delete anything sensitive). You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
As for the codes you're using, I'd have been inclined to used something closer to standard HTML: Code:
Sub aabFettKursivQuelldok() 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 aabFettKursivZieldok() Application.ScreenUpdating = False With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Format = True .Forward = True .MatchWildcards = True .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 .Text = "" to: .Text = "[!^13]{1,}"
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Dear Paul,
I am in love with your improved macros! They are working great and a lot faster than mine. Even the problem described above is -nearly- solved by it! I attached a Word2010 document as example. It works all fine, only after "1. Heading xy" the number 1.1 in the following paragraph becomes highlighted (after pasting in a new document and running the second macro). You can also see it at the tags, that end after 1.1 and not after Heading xy as they should. Is this maybe because of the automatic numbering? Last edited by Kalü; 04-12-2018 at 10:31 AM. |
#10
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Sadly it is not restoring the original formatting. The automatic number (1.1) in the following paragraph will be highlighted also it should not
But I guess there is no solution for it, or is there any? Where is your Donate-Button? I would like to give you some tip for your great help!! |
#12
|
||||
|
||||
I am unable to replicate the behaviour you say is occurring when I run the macros against your 'VBA Example' attachment. And just to make sure, I added:
ActiveDocument.Range.Font.Reset to the end of the first macro to strip out all character-level formatting (Paragraph Style formatting remains formatted as such). We don't have one; all help here is gratis.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Well thats weird because I still have the problem (please see in the attached document: 1.1 is highlighted).
Could it be that I added "ActiveDocument.Range.Font.Reset" at the wrong place in the macro? My first macro now looks like this: Code:
Sub aaaaaQuelldok() ' hyphenation off ActiveDocument.AutoHyphenation = False '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 ActiveDocument.Range.Font.Reset Application.ScreenUpdating = True End Sub Code:
Sub aaaaaZieldok() Application.ScreenUpdating = False With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Format = True .Forward = True .MatchWildcards = True .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 |
#14
|
||||
|
||||
Your latest attachment is not the same 'VBA Example' document you attached in post #9 after running both macros; it is an entirely different document, with different margins, different justification rules vis-ŕ-vis WordPerfect and no automatic numbering. Even the 'Title' paragraph is left-aligned instead of being centred. If ever the latest attachment was based on the 'VBA Example' document you attached in post #9, you've done far more to it than just running those two macros.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
Ok I just formatted a document by usig the new imrpoved macor and found out it doesnt work at all
Sad thing is that it is sensitive data and i cannot post here. But i can copy some examples, after running the frst makro, copy&paste in a new document and running the second macro i got a lot of passages that looks like this:
Interesting thing: when i run my old, long macros it works a little bit better and i dont get 5 pages completely bold. |
|
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 |