Find formatting in text in cell, insert tags around formatting.

[CarlC]

Hi,

I have cells containing bold or italic words within the text. I would like
to be able to search for the various formatting within the cells, insert tags
around the formatted words, and then remove the formatting.

The tags look like: <emph render="name of formatting">formatted words</emph>

Example:
Suppose the words "quick brown" were in bold, the text should look like:
"The <emph render="bold">quick brown</emph> fox jumps over..."

Is there an easy way to search for formatting within a cell and identify the
formatted words so that the tags can be inserted?

Thank
-Carl

 

[Rick Rothstein \(MVP - VB\)]

Give the subroutine after my signature a try. To use it, simply call it
while passing in the cell reference of the text you want to parse; something
like this...

ParseTxt ActiveSheet.Range("A1")

Note that this code will handle one font style embedded within another; so,
you can have a word that is both bold and italic; or your can have a bold
word embedded within a longer, italicized piece of text (or vice versa).

Rick

Sub ParseTxt(Cel As Range)
Dim X As Long
Dim Txt As String
Dim BoldOn As Boolean
Dim ItalicsOn As Boolean
If Cel.Count <> 1 Then Exit Sub
For X = 1 To Len(Cel.Value)
If Cel.Characters(X, 1).Font.Italic And Not ItalicsOn Then
ItalicsOn = True
Txt = Txt & "<emph render=""italic"">"
End If
If Cel.Characters(X, 1).Font.Bold And Not BoldOn Then
BoldOn = True
Txt = Txt & "<emph render=""bold"">"
End If
Txt = Txt & Mid$(Cel.Value, X, 1)
If Not Cel.Characters(X, 1).Font.Bold And BoldOn Then
BoldOn = False
Txt = Left(Txt, Len(Txt) - 1) & "</emph>" & Right(Txt, 1)
End If
If Not Cel.Characters(X, 1).Font.Italic And ItalicsOn Then
ItalicsOn = False
Txt = Left(Txt, Len(Txt) - 1) & "</emph>" & Right(Txt, 1)
End If
Next
If BoldOn Then
Txt = Txt & "</emph>"
End If
If ItalicsOn Then
Txt = Txt & "</emph>"
End If
Cel.Font.Italic = False
Cel.Font.Bold = False
Cel.Value = Txt
End Sub

 

[CarlC]

Thanks!! Works like a charm.

-Carl

Give the subroutine after my signature a try. To use it, simply call it
while passing in the cell reference of the text you want to parse; something
like this...

ParseTxt ActiveSheet.Range("A1")

Note that this code will handle one font style embedded within another; so,
you can have a word that is both bold and italic; or your can have a bold
word embedded within a longer, italicized piece of text (or vice versa).

Rick

Sub ParseTxt(Cel As Range)
Dim X As Long
Dim Txt As String
Dim BoldOn As Boolean
Dim ItalicsOn As Boolean
If Cel.Count <> 1 Then Exit Sub
For X = 1 To Len(Cel.Value)
If Cel.Characters(X, 1).Font.Italic And Not ItalicsOn Then
ItalicsOn = True
Txt = Txt & "<emph render=""italic"">"
End If
If Cel.Characters(X, 1).Font.Bold And Not BoldOn Then
BoldOn = True
Txt = Txt & "<emph render=""bold"">"
End If
Txt = Txt & Mid$(Cel.Value, X, 1)
If Not Cel.Characters(X, 1).Font.Bold And BoldOn Then
BoldOn = False
Txt = Left(Txt, Len(Txt) - 1) & "</emph>" & Right(Txt, 1)
End If
If Not Cel.Characters(X, 1).Font.Italic And ItalicsOn Then
ItalicsOn = False
Txt = Left(Txt, Len(Txt) - 1) & "</emph>" & Right(Txt, 1)
End If
Next
If BoldOn Then
Txt = Txt & "</emph>"
End If
If ItalicsOn Then
Txt = Txt & "</emph>"
End If
Cel.Font.Italic = False
Cel.Font.Bold = False
Cel.Value = Txt
End Sub