VBA 中的 HTML - 无法将单元格格式化为数字/货币

Question

我正在尝试使用 HTML 主体将表格从 excel 粘贴到 outlook 但我似乎无法正确获取数字格式。 excel 表的负数为红色，但是当转移到 outlook 时，它们都是黑色的。 以下是我正在使用的“转换为 HTML 代码”的一部分，不确定为什么没有选择 mso 数字格式

            If rCell.Column = 1 Then
                strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'><b>" & rCell.Text & "</b></td>"
            Else
               strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt;mso-number-format:\#\,\#\#0\.00_ \;\[Red\]\-\#\,\#\#0\.00\'>" & rCell.Text & "</td>"
            End If

function 的完整代码如下 -

公共 Function ConvertRangeToHTMLTable(rInput As Range) As String

Dim rRow As Range
Dim rCell As Range
Dim strReturn As String

strReturn = "<table border='1' cellspacing='0' cellpadding='7' style='border-collapse:collapse;border:none;width:650px'>"

For Each rRow In rInput.Rows

    strReturn = strReturn & " <tr align='Left'; style='height:10.00pt'> "
    For Each rCell In rRow.Cells

        If rCell.row = 1 Then
            strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt; background-color: rgb(180, 198, 231)'><b>" & rCell.Text & "</b></td>"
        ElseIf rCell.row = 11 Then
            strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt; background-color: rgb(180, 198, 231)'><b>" & rCell.Text & "</b></td>"
        Else
            If rCell.Column = 1 Then
                strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'><b>" & rCell.Text & "</b></td>"
            Else
               strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt;mso-number-format:\#\,\#\#0\.00_ \;\[Red\]\-\#\,\#\#0\.00\'>" & rCell.Text & "</td>"
            End If
        End If
    Next rCell
    
    
    strReturn = strReturn & "</tr>"
Next rRow

strReturn = strReturn & "</font></table>"

ConvertRangeToHTMLTable = strReturn

结束 Function

Answer 1

我用下面的function（修改自Ron de Bruin类似函数）来允许条件格式化等，保留：

Private Function CopyRangeToHTML(ByVal n As Range)
    Dim fso As Object, ts As Object, temp As String
    Dim wbs As Workbook: Set wbs = n.Worksheet.Parent
    temp = Environ$("temp") & "/" & Format(Now, "yyyyMMddHHmmss") & ".htm"
    With wbs.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=temp, Sheet:=n.Worksheet.Name, Source:=n.Address, HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(temp).OpenAsTextStream(1, -2)
    CopyRangeToHTML = ts.ReadAll
    ts.Close
    Kill temp
    Set ts = Nothing
    Set fso = Nothing
    Set wbs = Nothing
End Function

然后可以通过HTMLBody使用上面的 function ，例如：

.HTMLBody = .HTMLBody & CopyRangeToHTML(tableRangeRef)