0

我在 Excel 中编写了以下 VBA 函数，以将 Excel 单元格内容从混合格式转换为 HTML。这是我要转换的一个单元格的示例：

粗体字、斜体字、普通字、上标和删除线：
• 第 1 行及更多
• 第 2 行… lorem ipsum
• 第3 行

我想要这样的输出：

<b>Bold</b> type, <i>italics</i> type, plain type, <sup>super</sup>script and strike:<br>
&bull; Line 1 <b>& more</b><br>
&bull; Line 2… lorem <i>ipsum</i><br>
&bull; Line 3<br>

我的 VBA 函数：

Public Function ConvertToHTML(cell As Range)
'Find formatted text in a cell and enclose in HTML formatting tags
Dim strHTML, HTMLTag(3, 4), HTMLChar(2, 2) As String
Dim i As Integer

'Define searchable font properties that convert to HTML tags
HTMLTag(1, 1) = "bold" 'Font property name
HTMLTag(1, 2) = "<b>"  'HTML opening tag
HTMLTag(1, 3) = "</b>" 'HTML closing tag
HTMLTag(1, 4) = False  'Property flag
HTMLTag(2, 1) = "italic"
HTMLTag(2, 2) = "<i>"
HTMLTag(2, 3) = "</i>"
HTMLTag(3, 4) = False
HTMLTag(3, 1) = "superscript"
HTMLTag(3, 2) = "<sup>"
HTMLTag(3, 3) = "</sup>"
HTMLTag(3, 4) = False

'Define searchable characters that convert to HTML tags
HTMLChar(1, 1) = "•"
HTMLChar(1, 2) = "&bull;"
HTMLChar(2, 1) = Chr(10)
HTMLChar(2, 2) = "<br>" & Chr(10)

'Iterate through each character in cell
For i = 1 To Len(cell)
    With cell.Characters(i, 1)
        'Iterate through each font property (on or off)
        'Check if property has changed

        If Not (.Font.Strikethrough) Then 'If character has strikethrough, skip it

            'Add opening tags
            'Check if Bold state has changed
            If ((.Font.Bold <> HTMLTag(1, 4)) And .Font.Bold) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(1, 2)
                HTMLTag(1, 4) = .Font.Bold
            End If

            'Check if Italic state has changed
            If ((.Font.Italic <> HTMLTag(2, 4)) And .Font.Italic) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(2, 2)
                HTMLTag(2, 4) = .Font.Italic
            End If

            'Check if Superscript state has changed
            If ((.Font.Superscript <> HTMLTag(3, 4)) And .Font.Superscript) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(3, 2)
                HTMLTag(3, 4) = .Font.Superscript
            End If

            'Add closing tags
            If ((.Font.Superscript <> HTMLTag(3, 4)) And Not (.Font.Superscript)) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(3, 3)
                HTMLTag(3, 4) = .Font.Superscript
            End If

            If ((.Font.Italic <> HTMLTag(2, 4)) And Not (.Font.Italic)) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(2, 3)
                HTMLTag(2, 4) = .Font.Italic
            End If

            If ((.Font.Bold <> HTMLTag(1, 4)) And Not (.Font.Bold)) Then
                'Add opening tag and set flag to match
                strHTML = strHTML & HTMLTag(1, 3)
                HTMLTag(1, 4) = .Font.Bold
            End If

            'Append current character
            strHTML = strHTML & .Text
        End If
    End With
Next i
'Return fully converted text
ConvertToHTML = strHTML

'Do character replacement for HTML compatibility
For i = LBound(HTMLChar) To UBound(HTMLChar)
    strHTML = Replace(strHTML, HTMLChar(i, 1), HTMLChar(i, 2))
Next i

ConvertToHTML = strHTML

End Function

任何建议如何优化我的代码？理想情况下，我喜欢使用循环并引用数组中的字体属性名称，这样我就可以在数组中添加/删除属性（例如下划线、颜色等），但我无法让它工作。我在想类似的东西：

.Font.(HTMLTag(i,4)) 'to reference Bold, Italic, Superscript member in Font
.Font.Properties(HTMLTag(i,4))
If clxnOfFont[i].name = HTMLTag(i,4) Then ...

你可能明白了。感谢您的输入。我搜索的任何内容都无法帮助我完成这个变量属性引用。

4

0 回答 0