Excel 宏 VBA 使用 HTML 标记粗斜体下划线在单元格中强

Question

我一直在寻找转换字符串或单元格，例如：

[单元格 B2 示例] "This is a <b>test</b> cell <i>filled</i> with <strong>randomly placed html tags</strong>."

[需要的输出示例]“这是一个测试单元格填充与随机放置的html标签。”

我需要能够在同一个单元格或字符串中处理多种类型的标签 (<b></b> , <i></i> , <u></u> , <strong></strong>)。

到目前为止，有人帮助我做到了这一点：

    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

以上成功地将所需的文本加粗并从单元格中删除了视觉标签。 然而，当尝试同时包含斜体、下划线和强标签时，它只会在最后出现。其余的都被消灭了。

有没有更好的方法来做到这一点？ 可以不用打开IE等其他应用程序将多个html标签转换成excel字符串或单元格吗？

旁注，至于标签，如果它们的功能与粗体相同就可以了，如果这样更容易？

Answer 1

一旦您分配了单元格的 .Value 属性，任何按字符的字体格式都会丢失，因此您不能将其作为格式设置过程的一部分。

这是一种方法 - 不是防弹的，并且不会考虑（例如）相同标签的嵌套集或无效的 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

编辑 - 如果您对不涉及 IE 的更通用的方法感兴趣，您可以将 HTML 复制到剪贴板并将其粘贴到单元格中。这将为您提供所需的格式。

例如 - 从这里使用@GMCB 的代码：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