CODEWITHSUNDEEP
htmlexcelvba
MBF
MBF

Reputation: 366

Excel Macro VBA Use HTML Tags Bold Italics Underline Strong in Cell

I have been looking to convert a string or cell such as:

[Cell B2 Example] "This is a <b>test</b> cell <i>filled</i> with <strong>randomly placed html tags</strong>."

[Needed Output Example] "This is a test cell filled with randomly placed html tags."

I need to be able to process multiple types of tags (<b></b> , <i></i> , <u></u> , <strong></strong>) in the same cell or string.

So far, someone has helped me with getting this far:

    Dim Tag, Tend, Pstart, Pend As String
    
    'BOLD Text
    Tag = "<b>"       ' tag string: start
    Tend = "</b>"      ' tag string: end
    Pstart = 0          ' vector index of Pos()
    Pend = 1          ' vector index of Pos()
    
    Dim Cv          As String               ' Cell value
    Dim Cnt         As Integer              ' instances of bold expressions
    Dim Pos()       As Variant              ' string positions: 0 = start, 1 = End
    Dim f           As Integer              ' loop counter: Cnt
    
    Cv = Range("B2").Value
    Cnt = (Len(Cv) - Len(Replace(Cv, Tag, ""))) / 3
    ReDim Pos(Cnt, Pend)
    For f = 1 To Cnt
        Pos(f, Pstart) = InStr(Cv, Tag)
        Cv = Left(Cv, Pos(f, Pstart) - 1) & Mid(Cv, Pos(f, Pstart) + Len(Tag), Len(Cv))
        Pos(f, Pend) = InStr(Cv, Tend) - 1
        Cv = Left(Cv, Pos(f, Pend)) & Mid(Cv, Pos(f, Pend) + Len(Tend) + 1, Len(Cv))
    Next f
    
    With Range("B2")
        .Font.Bold = False
        .Value = Cv
        For f = 1 To Cnt
            .Characters(Pos(f, Pstart), Pos(f, Pend) - Pos(f, Pstart) + 1).Font.Bold = True
        Next f
    End With

The above successfully makes needed text bold AND removes the visual tags from the cell. However, when trying to also incorporate italics, underline, and strong tags, it only does which ever come last. The rest get wiped out.

Is there a better way to do this? Can multiple html tags be converted in excel strings or cells WITHOUT having to open other applications such as IE, etc?

Side note, as for the tags, it would be fine if they functioned the same as bold, if that makes it easier?

Upvotes: 0

Views: 2093

Answers (1)

Tim Williams
Tim Williams

Reputation: 166306

As soon as you assign the cell's .Value property, any per-character font formatting will be lost, so you can't do that as part of the formatting process.

Here's one way to do it - not bulletproof and will not account for (eg) nested sets of the same tag or invalid HTML...

Sub Tester()
    Dim c As Range
    
    Set c = ActiveSheet.Range("D5")
    ActiveSheet.Range("D2").Copy c 'for testing:copy the input string
    
    FormatTags c, "b", "bold"
    FormatTags c, "i", "italic"
    FormatTags c, "strong", "bold"
    FormatTags c, "u", "underline"
    
End Sub

Sub FormatTags(c As Range, tag As String, prop As String)
    Dim pOpen As Long, pClose As Long, numChars As Long
    Dim sOpen, sClose
    sOpen = "<" & tag & ">"        'the open tag
    sClose = "</" & tag & ">"      'close tag
    pOpen = InStr(c.Value, sOpen)  'have an open tag?
    Do While pOpen > 0
        pClose = InStr(pOpen + 1, c.Value, sClose)  'find next close tag
        If pClose > 0 Then
            c.Characters(pClose, Len(sClose)).Delete 'remove the close tag first
            c.Characters(pOpen, Len(sOpen)).Delete   'remove the open tag
            'set the named font property
            numChars = pClose - (pOpen + Len(sOpen))
            CallByName c.Characters(pOpen, numChars).Font, prop, VbLet, True
            pOpen = InStr(c.Value, sOpen) 'find next, if any
        Else
            Exit Do 'no closing tag - all done
        End If
    Loop
End Sub

Edit - if you're interested in a more general-purpose approach which doesn't involve IE you can copy the HTML to the clipboard and paste it to a cell. That will give you the formatting you want.

Eg - using @GMCB's code from here: Injecting RTF code in the Clipboard to paste into MS Word as RTF text via a VBA macro

With ActiveSheet
    myClipboard.SetClipboardText .Range("D5").value, "HTML Format"
    .Paste Destination:=.Range("D5")
End With

Upvotes: 1

Related Questions