将Excel中显示html效果

来源:互联网 发布:日本留学生中国知乎 编辑:程序博客网 时间:2024/05/16 17:06

当做报表开发时候,如果要求输出一些html格式,发现输出的是html代码,而不是html的效果

但是将代码从剪切板黏贴到单元格时候就能顺利显示出html效果,通过这个比较,于是有了思路

做一个vba开发,先将htmlcode放到剪切板中,然后再从剪切板黏贴到excel单元格中

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sheet1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Sub code2html()
    Dim i, j, g, p
    Dim objData As DataObject
    Dim sHTML As String
    Dim sSelAdd As String
    Const sTEMP As String = "||||"
    Application.EnableEvents = False
    g = ActiveSheet.UsedRange.Rows.Count
    p = (g / 32) + 1
    If Range("A31").Value <> "." Then '如果A31单元格不是',表示还没有将html代码转换成html
        For j = 1 To p
        For i = (9 + (j - 1) * 32) To (26 + (j - 1) * 32)
        
              '拆分单元格
              Range("E" & (i) & ":V" & (i)).Select
                    'With Selection
                    '.HorizontalAlignment = xlCenter
                    '.VerticalAlignment = xlTop
                    '.WrapText = True
                    '.Orientation = 0
                   ' .AddIndent = False
                    '.IndentLevel = 0
                   ' .ShrinkToFit = False
                   ' .ReadingOrder = xlContext
                   ' .MergeCells = False
                   ' End With
                Selection.UnMerge
        If True Then
            If LCase(Left(Range("E" & (i)).Value, 6)) = "<html>" Then
                Set objData = New DataObject
                sHTML = Range("E" & (i)).Value
                sHTML = Replace(sHTML, "<br />", sTEMP)
                objData.SetText sHTML
                objData.PutInClipboard
    
                ActiveSheet.Paste Destination:=Range("E" & (i))
            End If
        End If
                '合并单元格
                Range("E" & (i) & ":V" & (i)).Select
                   ' With Selection
                    '.HorizontalAlignment = xlCenter
                    '.VerticalAlignment = xlTop
                   ' .WrapText = True
                   ' .Orientation = 0
                   ' .AddIndent = False
                   ' .IndentLevel = 0
                   ' .ShrinkToFit = False
                  '  .ReadingOrder = xlContext
                   ' .MergeCells = False
                   ' End With
                Selection.Merge
        Next
        Next
        '最后给A31加上'符号标识已经将所有code代码转换成html了
        Range("A31").Select
        ActiveCell.FormulaR1C1 = "."
    End If
    Application.EnableEvents = True
End Sub


原创粉丝点击