![]() |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
![]()
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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
redzan | Word VBA | 4 | 02-13-2016 12:24 PM |
![]() |
paik1002 | Word VBA | 4 | 12-07-2015 11:24 PM |
![]() |
kjxavier | Word | 1 | 01-02-2015 12:15 AM |
![]() |
rsrasc | Word VBA | 3 | 11-11-2014 03:55 PM |
![]() |
redzan | Word VBA | 1 | 07-27-2014 03:35 PM |