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

以上成功地使所需的文本變粗並從單元格中刪除了視覺標簽。 但是，當嘗試同時包含斜體、下划線和強標記時，它只會使用最后一個。 其余的被消滅。

有一個更好的方法嗎？ 是否可以在 excel 字符串或單元格中轉換多個 html 標簽，而無需打開其他應用程序，例如 IE 等？

旁注，至於標簽，如果它們的功能與粗體相同就好了，如果這樣更容易？

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