#1
|
|||
|
|||
Find/remove underline with specific color
Hi,
Is there a way to find and remove underlines which underline color is <> of wdColorAutomatic? I was thinking about find/replace routine, but it not accepts "<>" signal in search criteria Thanks
__________________
Backup your original file before doing any modification. |
#2
|
|||
|
|||
1. Find/remove underline with specific color?
2. Is there a way .... which underline color is <> wdColorAutomatic Those are two separate questions. Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Font.UnderlineColor = wdColorRed While .Execute oRng.Font.Underline = wdUnderlineNone Wend End With lbl_Exit: Exit Sub End Sub Sub ScratchMacroII() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Font.Underline = True While .Execute If oRng.Font.UnderlineColor <> wdColorAutomatic Then oRng.Font.Underline = wdUnderlineNone End If Wend End With lbl_Exit: Exit Sub End Sub |
#3
|
|||
|
|||
Thanks gmaxey,
I think that the code needed is the second, but it only remove underline from the 1st occurrence of a underline <> wdcolorautomatic.
__________________
Backup your original file before doing any modification. |
#4
|
|||
|
|||
This adaptation based on your code works but results in infinite loop
The Exit Do is not working. Update: the code below does not work if the document have headers. The document can have words underlined in up to 3 colors or none underlined, one of which is automatic. I need to remove only underlines that are not wdColorAutomatic. Code:
Set oRng = ActiveDocument.range With oRng.Find .Font.Underline = True .Forward = True .Wrap = wdFindContinue .Execute Do While .Found If oRng.Font.UnderlineColor <> wdColorAutomatic Then oRng.Font.Underline = wdUnderlineNone End If If .Found = ActiveDocument.range.End Then Exit Do .Execute Loop End With Maybe this is impossible with find/found loop, with for/next loop (each word) I was able to get the task done, but takes a lot of time. For now I chose to simply remove the entire underline. Thanks!
__________________
Backup your original file before doing any modification. Last edited by eduzs; 07-26-2020 at 05:12 PM. |
#5
|
||||
|
||||
It is not impossible -
Code:
Sub Macro1() Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Font.Underline = True Do While .Execute If Not oRng.Font.UnderlineColor = wdColorAutomatic Then oRng.Font.Underline = wdUnderlineNone End If oRng.Collapse 0 Loop End With lbl_Exit: Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#6
|
|||
|
|||
Hello, for a reason I don't know, this code is not working.
During execution, does not even enter the while loop.
__________________
Backup your original file before doing any modification. |
#7
|
||||
|
||||
It works fine - post a copy of your document so that we can see why it doesn't work there.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#8
|
|||
|
|||
Hi!
I identified the problem, at least in my document the ".Font.Underline" property does not works with boolean true/false values, instead, it should need one of wdUnderline enumeration values. The document have two underline types , value 1 = wdUnderlineSingle and 2 wdUnderlineWords, using two steps (with 1 or 2 instead of true) it works fine. Now I need a way to translate this to the code above. Thanks all for helping.
__________________
Backup your original file before doing any modification. Last edited by eduzs; 07-27-2020 at 04:06 PM. |
#9
|
|||
|
|||
To catch headers, footers and other areas of a document you will need to loop through the storyranges. It is more complicated than the code below but this might work:
Code:
Sub Macro1() Dim oRng As Range For Each oRng In ActiveDocument.StoryRanges With oRng.Find .Font.Underline = wdUnderlineSingle Do While .Execute If Not oRng.Font.UnderlineColor = wdColorAutomatic Then oRng.Font.Underline = wdUnderlineNone End If oRng.Collapse 0 Loop End With Set oRng = ActiveDocument.Range With oRng.Find .Font.Underline = wdUnderlineWords Do While .Execute If Not oRng.Font.UnderlineColor = wdColorAutomatic Then oRng.Font.Underline = wdUnderlineNone End If oRng.Collapse 0 Loop End With Next oRng lbl_Exit: Exit Sub End Sub |
#10
|
|||
|
|||
Thanks gmaxey and gmayor! Works as intended.
Now only minor changes are needed, I will mark this topic as solved. Ps: I changed the codes that underline texts so that they use only one form of underlining, avoiding the need for a loop or two steps editing.
__________________
Backup your original file before doing any modification. Last edited by eduzs; 07-27-2020 at 03:57 PM. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Remove white text background (keeping the font color and page color intact | cc3125 | Word | 1 | 10-26-2015 06:44 PM |
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color | jc491 | Word VBA | 8 | 09-30-2015 06:10 AM |
Find instance of a word in a specific style and change its color | hwg | Word VBA | 7 | 02-20-2014 10:59 PM |
remove color from find/replace? | Cobb78 | Word | 1 | 05-26-2012 06:16 PM |
How to remove the UNDERLINE from a hyperlink text? | Learner7 | PowerPoint | 3 | 05-17-2010 09:35 PM |