Блог

Я пытаюсь вставить таблицу из excel в outlook, используя текст HTML, но, похоже, я не могу правильно выбрать формат чисел. На листе Excel отрицательные числа обозначены красным цветом, однако при переносе в outlook они все черные. Следующее является частью «преобразования в HTML-код», который я использую, не уверен, почему формат номера mso не выбирается

 If rCell.Column = 1 Then  strReturn = strReturn amp; "lt;td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'gt;lt;bgt;" amp; rCell.Text amp; "lt;/bgt;lt;/tdgt;"  Else  strReturn = strReturn amp; "lt;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'gt;" amp; rCell.Text amp; "lt;/tdgt;"  End If  

Полный код этой функции приведен ниже —

Публичная Функция ConvertRangeToHTMLTable(ввод В качестве Диапазона) Как Строка

 Dim rRow As Range Dim rCell As Range Dim strReturn As String  strReturn = "lt;table border='1' cellspacing='0' cellpadding='7' style='border-collapse:collapse;border:none;width:650px'gt;"  For Each rRow In rInput.Rows   strReturn = strReturn amp; " lt;tr align='Left'; style='height:10.00pt'gt; "  For Each rCell In rRow.Cells   If rCell.row = 1 Then  strReturn = strReturn amp; "lt;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)'gt;lt;bgt;" amp; rCell.Text amp; "lt;/bgt;lt;/tdgt;"  ElseIf rCell.row = 11 Then  strReturn = strReturn amp; "lt;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)'gt;lt;bgt;" amp; rCell.Text amp; "lt;/bgt;lt;/tdgt;"  Else  If rCell.Column = 1 Then  strReturn = strReturn amp; "lt;td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'gt;lt;bgt;" amp; rCell.Text amp; "lt;/bgt;lt;/tdgt;"  Else  strReturn = strReturn amp; "lt;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'gt;" amp; rCell.Text amp; "lt;/tdgt;"  End If  End If  Next rCell      strReturn = strReturn amp; "lt;/trgt;" Next rRow  strReturn = strReturn amp; "lt;/fontgt;lt;/tablegt;"  ConvertRangeToHTMLTable = strReturn  

Конечная Функция

Я использую следующую функцию (измененную по сравнению с аналогичной функцией Рона де Брюна), Чтобы разрешить условное форматирование и т. Д., Остаются:

 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") amp; "/" amp; Format(Now, "yyyyMMddHHmmss") amp; ".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 amp; CopyRangeToHTML(tableRangeRef)