View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Strikethrough Red and Underline Blue Macro

Ignore previous, somehow I pasted completely wrong code which was part draft
of the following, which I intended to post first time. These things happen!

Sub test()
Dim X As Long
Dim cel As Range
Dim ch As Font
Dim vst, vun
For Each cel In Selection

X = FntFormat(cel.Font)
If X = 0 Then
For i = 1 To Len(cel)
cel.Characters(i, 1).Font.ColorIndex = _
FntFormat(cel.Characters(i, 1).Font)
Next
Else
cel.Font.ColorIndex = X
End If
Next
End Sub

Function FntFormat(fnt As Font) As Long
Dim v1, v2
Dim X As Long
v1 = fnt.Strikethrough
v2 = (fnt.Underline < xlUnderlineStyleNone)
If IsNull(v1) Or IsNull(v2) Then
X = 0
Else
X = xlAutomatic
If v1 Then X = 3
If v2 Then
If X 0 Then X = 13 Else X = 5
End If
End If
FntFormat = X
End Function

Peter T
"Peter T" <peter_t@discussions wrote in message
...
So what colour do you want if both strikethrough & underline. As you

didn't
specify the following will colour font
- strikethrough to red
- underline to blue
- strikethrough + underline to violet
- not strickthrough & not underline to system black (automatic)

Start by selecting the cells you want processed

Sub test()
Dim X As Long
Dim cel As Range
Dim ch As Font
Dim vst, vun
For Each cel In Selection

X = 0
If FntFormat(cel.Font) = 0 Then
For i = 1 To Len(cel)
cel.Characters(i, 1).Font.ColorIndex = _
FntFormat(cel.Characters(i, 1).Font)
Next
Else
cel.ColorIndex = X
End If
Next
End Sub

Function FntFormat(fnt As Font) As Long
Dim v1, v2
Dim X As Long
v1 = fnt.Strikethrough
v2 = (fnt.Underline < xlUnderlineStyleNone)
If IsNull(v1) Or IsNull(v2) Then
X = 0
Else
X = xlAutomatic
If v1 Then X = 3
If v2 Then
If X Then X = 13 Else X = 5
End If
End If
FntFormat = X
End Function

You message implied there might be mixed formats in the same cell, the

above
should cater for that possibility. If not it's overkill.

Regards,
Peter T

"Rainman76" wrote
in message ...

I have successfully written a Macro in Word to change the font color of
all text that has a strikethrough to red and all text that has an
underline I change the font to blue.

Can someone help me out with an Excel Macro like this? Keep in mind a
cell can contain text that has both underlined text and strikethrough
text within it.


--
Rainman76
------------------------------------------------------------------------
Rainman76's Profile:

http://www.excelforum.com/member.php...o&userid=26091
View this thread:

http://www.excelforum.com/showthread...hreadid=394182