迭代Excel VBA对象属性

时间:2014-04-03 00:45:56

标签: html excel-vba richtext strikethrough vba

我在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 ... 

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

0 个答案:

没有答案