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

Posted 2023-03-27

【中文标题】VBA 中的 HTML - 无法将单元格格式化为数字/货币

【英文标题】：How to format cell as number/currency using HTML in VBA?

【发布时间】：2022-01-08 06:36:29

【问题描述】：

我正在尝试使用 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

函数的完整代码如下-

公共函数 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

结束函数

【参考方案1】：

我使用以下函数（修改自 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使用上面的功能了，比如：

.HTMLBody = .HTMLBody & CopyRangeToHTML(tableRangeRef)