在html正文中保留单元格中的文本格式

时间:2014-06-25 13:18:32

标签: vba excel-vba outlook-vba excel

我只是一个简单的问题:

在emailSender.Cells(2,5)中存储了我想在电子邮件的html主体中使用的文本,但我需要保持这个单元格中的确切格式,我该怎么办?

With MItem
        .To = EmailAddr
        .Subject = Subj
            Do While j <= lastRow
                Set searchResult3 = report.Columns(1).Find(tickets.Cells(j, i), LookIn:=xlValues)
                .HTMLBody = .HTMLBody & "<tr>" & "<td width=""120"">" & tickets.Cells(j, i) & "</td>" & "<td width=""250"">" & searchResult3.Offset(0, 3) & "</td>" & "</tr>"
                j = j + 1
            Loop
        .HTMLBody = emailSender.Cells(2, 5) & "<table border=""1"" bordercolor=black style=""border-collapse: collapse"">" & .HTMLBody & "</table>" & "<br>" & signature
        .Display
     End With

感谢您的帮助:)

1 个答案:

答案 0 :(得分:0)

我用Google搜索&#34; excel vba将单元转换为html&#34;并且提出的第一个结果是一个完整的解决方案。

浏览此代码,我可以看到它是粗体,斜体,下划线和字体颜色。如果你需要的话,你应该能够轻松地调整字体颜色代码来做字体大小。

Function fnConvert2HTML(myCell As Range) As String
Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean
Dim i, chrCount As Integer
Dim chrCol, chrLastCol, htmlTxt As String

bldTagOn = False
itlTagOn = False
ulnTagOn = False
colTagOn = False
chrCol = "NONE"
htmlTxt = "<html>"
chrCount = myCell.Characters.Count

For i = 1 To chrCount
    With myCell.Characters(i, 1)
        If (.Font.Color) Then
            chrCol = fnGetCol(.Font.Color)
            If Not colTagOn Then
                htmlTxt = htmlTxt & "<font color=#" & chrCol & ">"
                colTagOn = True
            Else
                If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "</font><font color=#" & chrCol & ">"
            End If
        Else
            chrCol = "NONE"
            If colTagOn Then
                htmlTxt = htmlTxt & "</font>"
                colTagOn = False
            End If
        End If
        chrLastCol = chrCol

        If .Font.Bold = True Then
            If Not bldTagOn Then
                htmlTxt = htmlTxt & "<b>"
                bldTagOn = True
            End If
        Else
            If bldTagOn Then
                htmlTxt = htmlTxt & "</b>"
                bldTagOn = False
            End If
        End If

        If .Font.Italic = True Then
            If Not itlTagOn Then
                htmlTxt = htmlTxt & "<i>"
                itlTagOn = True
            End If
        Else
            If itlTagOn Then
                htmlTxt = htmlTxt & "</i>"
                itlTagOn = False
            End If
        End If

        If .Font.Underline > 0 Then
            If Not ulnTagOn Then
                htmlTxt = htmlTxt & "<u>"
                ulnTagOn = True
            End If
        Else
            If ulnTagOn Then
                htmlTxt = htmlTxt & "</u>"
                ulnTagOn = False
            End If
        End If

        If (Asc(.Text) = 10) Then
            htmlTxt = htmlTxt & "<br>"
        Else
            htmlTxt = htmlTxt & .Text
        End If
    End With
Next

If colTagOn Then
    htmlTxt = htmlTxt & "</font>"
    colTagOn = False
End If
If bldTagOn Then
    htmlTxt = htmlTxt & "</b>"
    bldTagOn = False
End If
If itlTagOn Then
    htmlTxt = htmlTxt & "</i>"
    itlTagOn = False
End If
If ulnTagOn Then
    htmlTxt = htmlTxt & "</u>"
    ulnTagOn = False
End If
htmlTxt = htmlTxt & "</html>"
fnConvert2HTML = htmlTxt
End Function

Function fnGetCol(strCol As String) As String   
Dim rVal, gVal, bVal As String
strCol = Right("000000" & Hex(strCol), 6)
bVal = Left(strCol, 2)
gVal = Mid(strCol, 3, 2)
rVal = Right(strCol, 2)
fnGetCol = rVal & gVal & bVal
End Function

然而,下次尝试谷歌,所以你至少可以说&#34;我已经尝试过x,y,z这样做的方式&#34;。

请注意,此代码不是我的。

链接:http://social.msdn.microsoft.com/Forums/en-US/626a351a-de17-4389-9ad6-a2be20ce2fd9/convert-contents-of-a-formatted-excel-cell-to-html-format?forum=isvvba