Styles in a cell

  • Thread starter Thread starter sriramp777
  • Start date Start date
S

sriramp777

hi,
i have a problem with changing the styles in the cells.

Suppose a cell contains some text, say "<F><Center 354><N><F><U>Test
String<G><N>"
where,
the text between <F> and <N> are made bold and the text between <U> and
<G> are made underline.

This i want to make it through the VBA Code. The text with bold and
underline style can be done individually, but the thing is when there
is a combination of both, it doesn't happen. All the previous styles
are taken off from the cell and only the underline style remains...
Finally, the cell content shud be
<CENTER 354>[/B]_TESTSTRING_

Can anyone help me out with this issue??
Again, all this have to be done with VBA..

Thanks and regards,
Sriram
 
Hi,

maybe I didn't understand you correctly, but:

With ActiveCell.Characters(Start:=4, Length:=12).Font
.Name = "Courier"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=25, Length:=11).Font
.Name = "Courier"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
End With

Just copied from macro recorder. Sure, you need to change start and
length to suit your needs.

Regards,
Ivan
 
Sub abc()
Dim v() As String
Dim sChr As String, s As String
Dim s1 As String, s2 As String
Dim rng As Range, bBold As Boolean
Dim bUnd As Boolean
Dim i As Long, j As Long, k As Long
Set rng = ActiveCell
s = "<F><Center 354><N><F><U>TestString<G><N>"
s1 = s & " "
ReDim v(1 To Len(s))
j = 1
i = 1
k = 1
Do While i <= Len(s)
sChr = Mid(s1, i, 1)
If sChr = "<" Then
If Mid(s1, i + 2, 1) = ">" Then
Select Case LCase(Mid(s1, i + 1, 1))
Case "f"
v(j) = "boldOn"
Case "n"
v(j) = "boldOff"
Case "u"
v(j) = "undOn"
Case "g"
v(j) = "undOff"
End Select
j = j + 1
i = i + 3
Else
v(j) = k
s2 = s2 & sChr
j = j + 1
i = i + 1
k = k + 1
End If
Else
v(j) = k
s2 = s2 & sChr
j = j + 1
i = i + 1
k = k + 1
End If
Loop
rng.Value = s2
bBold = False
bUnd = False
For j = 1 To Len(s)
If v(j) = "boldOn" Then bBold = True
If v(j) = "boldOff" Then bBold = False
If v(j) = "undOn" Then bUnd = True
If v(j) = "undOff" Then bUnd = False
If IsNumeric(v(j)) And v(j) <> "" Then
rng.Characters(v(j), 1).Font.Bold = bBold
rng.Characters(v(j), 1).Font.Underline = bUnd
End If
Next
End Sub
 
Back
Top