Convert Excel Range to HTML-Table - html

Question

Because I didn't find a proper solution, I developed an own code to convert an excel range into an html table. The result is a string and can be used within a mail for example.

Answer 1

The following code considers: cell dimension, font-family, -style, -size and alignment, border-style and -color (top, right, bottom, left) and interior-color
Function convertRangeToHtml(rng As Range) As String
Dim r As Range
Dim c As Range
Dim strHtml As String
strHtml = "<table style=" & Chr(34) & "border-collapse: collapse;" & Chr(34) & " > " & vbNewLine & "<tbody>"
For Each r In rng.Rows
strHtml = strHtml & vbTab & "<tr>" & vbNewLine
For Each c In r.Columns
strHtml = strHtml & vbTab & vbTab & "<td " & getCellDimension(c) & " style=" & Chr(34) & getFontStyle(c) & " " & getBorder(c) & " " & getInteriorColor(c) & Chr(34) & ">" & Trim(c.Text) & "</td>" & vbNewLine
Next c
strHtml = strHtml & vbTab & "</tr>" & vbNewLine
Next r
strHtml = strHtml & "</table>" & vbNewLine & "</tbody>"
Debug.Print strHtml
convertRangeToHtml = strHtml
End Function
Function getInteriorColor(r As Range) As String
getInteriorColor = "background-color: rgb(" & color2rgb(r.DisplayFormat.Interior.Color) & "); "
End Function
Function getBorder(r As Range) As String
Dim varBorderSytle As Variant
varBorderSytle = "border-style: "
Dim varBorderWidth As Variant
varBorderWidth = "border-width: "
Dim varBorderColor As Variant
varBorderColor = "border-color: "
For Each b In Array(8, 10, 9, 7)
Select Case r.Borders(b).LineStyle
Case -4115
varBorderSytle = varBorderSytle & "dashed "
Case -4142
varBorderSytle = varBorderSytle & "none "
Case 1
varBorderSytle = varBorderSytle & "solid "
Case -4118
varBorderSytle = varBorderSytle & "dotted "
Case Else
varBorderSytle = varBorderSytle & "solid "
End Select
Select Case r.Borders(b).Weight
Case 1
varBorderWidth = varBorderWidth & "1px "
Case -4138
varBorderWidth = varBorderWidth & "2px "
Case 4
varBorderWidth = varBorderWidth & "3px "
Case 2
varBorderWidth = varBorderWidth & "1px "
Case Else
varBorderWidth = varBorderWidth & "1px "
End Select
varBorderColor = varBorderColor & "rgb(" & color2rgb(r.Borders(b).Color) & ") "
Next b
varBorderSytle = varBorderSytle & ";"
varBorderWidth = varBorderWidth & ";"
varBorderColor = varBorderColor & ";"
getBorder = varBorderSytle & " " & varBorderWidth & " " & varBorderColor
End Function
Function getCellDimension(r As Range) As String
getCellDimension = "width=" & Chr(34) & r.Width * 96 / 72 & "" & Chr(34) & " height=" & Chr(34) & r.Height * 96 / 72 & "" & Chr(34)
End Function
Function getFontStyle(r As Range) As String
Dim varFontColor As Variant
Dim varFontName As Variant
Dim varFontStyle As Variant
Dim varFontSize As Variant
Dim varFontBold As Variant
Dim varFontItalic As Variant
Dim varTextAlign As Variant
varFontColor = "color: rgb(" & color2rgb(r.DisplayFormat.Font.Color) & "); "
varFontName = "font-family: " & r.Font.Name & "; "
varFontSize = "font-size: " & r.DisplayFormat.Font.Size & "pt; "
varFontBold = "font-weight: normal; "
If r.DisplayFormat.Font.Bold Then varFontBold = "font-weight: bold; "
varFontStyle = "font-style: normal; "
If r.DisplayFormat.Font.Italic Then varFontStyle = "font-style: italic; "
Select Case r.HorizontalAlignment
Case -4131
varTextAlign = "text-align: left; "
Case -4152
varTextAlign = "text-align: right; "
Case -4108
varTextAlign = "text-align: center; "
Case -4130
varTextAlign = "text-align: justify; "
Case 1
Select Case Application.Evaluate("TYPE(" & r.Address(0, 0, external:=True) & ")")
Case 1
varTextAlign = "text-align: right; "
Case 2
varTextAlign = "text-align: left; "
Case 4, 16
varTextAlign = "text-align: center; "
Case Else
varTextAlign = "text-align: start; "
End Select
End Select
Dim strCSS As String
strCSS = varFontColor & varFontName & varFontSize & varFontBold & varFontStyle & varTextAlign
getFontStyle = strCSS
End Function
Function color2rgb(varColor As Variant) As String
color2rgb = Format((varColor Mod 256), "00") & ", " & Format(((varColor \ 256) Mod 256), "00") & ", " & Format((varColor \ 65536), "00")
End Function
Additionally I would suggest to add a css-style wihtin the final html-file:
td {
padding:1pt 4pt 1pt 4pt;
}