Every time I write a RangeToHTML function, it’s different. I don’t re-use my old functions because the HTML elements that I care about change from project to project. I could make a generic RangeToHTML function that attempts to capture every possible cell property, but I don’t. I don’t want a bunch of code in my project that doesn’t do anything. I figure out which cell properties matter to the project and code those.
In this example, I not only did not want fidelity with the spreadsheet, I was using bold and italics to trigger completely different HTML elements. But usually I’m trying to make the cells look like they do in the spreadsheet for those characteristics that I’ve deemed important. Below is another example where I’m converting a range to HTML to put into an Outlook email. The things that are important to me are bold, italics, font size, cell alignment, merged cells, and bottom borders. That’s a lot of stuff, but it’s not every formatting element that could be applied to a cell.
Public Function RangeToHTML(ByRef rRng As Range) As String
Dim rRow As Range, rCell As Range
Dim sTable As String, sTd As String, sHead As String
Dim aCells() As String, aRows() As String, aAttr() As String, aHead(1 To 2) As String
Dim lCellCnt As Long, lRowCnt As Long
Dim lFontSize As Long
‘1. Get the font size of the last cell
lFontSize = rRng.Cells(rRng.Cells.Count).Font.Size
ReDim aRows(1 To rRng.Rows.Count)
‘2 create the style in the header
aHead(1) = "td {font-family:" & rRng.Cells(1).Font.Name & "; font-size: " & lFontSize & "pt}"
aHead(2) = ".bb {border-bottom: 1px solid black}"
sHead = Tag(Tag(Join(aHead, vbNewLine), "style", , True), "head", , True)
‘3. Load up a ‘cells’ array and a ‘rows’ array FOR joining.
For Each rRow In rRng.Rows
lRowCnt = lRowCnt + 1: lCellCnt = 0
ReDim aCells(1 To rRng.Columns.Count)
For Each rCell In rRow.Cells
lCellCnt = lCellCnt + 1
‘4. Deal with empty cells and multi-line cells
If IsEmpty(rCell.Value) Then
sTd = " "
Else
sTd = Replace(rCell.Text, Chr$(10), "<br />")
End If
‘5. Bold and italic
If rCell.Font.Bold Then sTd = Tag(sTd, "strong")
If rCell.Font.Italic Then sTd = Tag(sTd, "em")
‘6. Font size
If rCell.Font.Size <> lFontSize Then
sTd = Tag(sTd, "div", "style=font-size:" & rCell.Font.Size & "pt")
End If
‘7. Setting the cell alignment
ReDim aAttr(1 To 3)
aAttr(1) = AlignmentAttr(rCell)
‘8. Span rows and columns for merged cells
If rCell.MergeArea.Address <> rCell.Address Then
aAttr(2) = "COLSPAN=""" & rCell.MergeArea.Columns.Count & """ ROWSPAN=""" & rCell.MergeArea.Rows.Count & """"
End If
‘9. Bottom border
If rCell.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone Then
aAttr(3) = "class=""bb"""
End If
’10. Make string
If rCell.MergeArea.Cells(1).Address = rCell.Address Then
aCells(lCellCnt) = Tag(sTd, "td", Join(aAttr, Space(1)))
End If
Next rCell
aRows(lRowCnt) = Tag(Join(aCells, vbNewLine), "tr", , True)
Next rRow
sTable = Tag(Join(aRows, vbNewLine), "table", "cellpadding=""2px""", True)
RangeToHTML = Tag(sHead & vbNewLine & sTable, "html", , True)
End Function
Here’s a breakdown of code:
- It’s a bit arbitrary, but I’m pulling the font size from the last cell in the range. For my data, I know that the header may have a different font size, but there is no footer. Whatever the last cell in the range is, that’s my default font size.
- I create two styles in the header: one for the default td element and one for the “bb” class (bottom border). The font name is pulled from the first cell of the range (because I know there’s o change in font family within the range. The font size I get from above. My Tag function is nested here so that my styles are in a ‘style’ tag and then the whole thing is wrapped in a ‘head’ tag.
- Inside the loop, I fill the aCells array with each cell. Before I go to the next row, I Join that array into an element of the aRows array. Later I’ll be Joining that array into a big string.
- If the cell is empty, I need a non-breaking space in my td tags. If the cell has more than one line, I insert the br HTML tag to replicate that.
- At this point, I’m just checking out the cell properties and converting them to HTML. These two lines wrap the value in ‘strong’ or ‘em’ if the cell is bold or italic, respectively.
- I got the default font size up in step 1. If this cells font size is different than the default, then I set it explicitly. I’d considered trying to make everything a relative font size, but ultimately it was a pain and unnecessary.
- There are three cell properties that will turn into attributes in the td tag. The first is the cell alignment. I have left, right, and center cells and set the align property using the AlignmentAttr function shown below.
- Next, I look for merged cells and set the COLSPAN and ROWSPAN attributes accordingly. Yes, I hate merged cells too, but sometimes they’re necessary.
- The I look for a bottom border, which I implement in a css class. I don’t look for every border because I only care about bottom borders.
- Finally, I make the string by Joining my Attr array. If I’m in the first cell of a merged area (which also is true if there is no merge area), then I make the string. If I’m not in the first cell, I don’t do anything because I’ve already done it back when I was in the first cell.
To wrap it all I up, I tag and join everything into one glorious string. The Tag function looks like this:
Function Tag(sValue As String, sTag As String, Optional sAttr As String = "", Optional bIndent As Boolean = False) As String
Dim sReturn As String
If Len(sAttr) > 0 Then
sAttr = Space(1) & sAttr
End If
If bIndent Then
sValue = vbTab & Replace(sValue, vbNewLine, vbNewLine & vbTab)
sReturn = "<" & sTag & sAttr & ">" & vbNewLine & sValue & vbNewLine & "</" & sTag & ">"
Else
sReturn = "<" & sTag & sAttr & ">" & sValue & "</" & sTag & ">"
End If
Tag = sReturn
End Function
The AlignmentAttr function from #7 above. I put this in its own function to keep the close a little cleaner, not because it does anything special.
Public Function AlignmentAttr(ByRef rCell As Range) As String
Dim sReturn As String
Select Case True
Case rCell.HorizontalAlignment = xlLeft, (rCell.HorizontalAlignment = 1 And Not IsNumeric(rCell.Value))
sReturn = "align=""left"""
Case rCell.HorizontalAlignment = xlRight, (rCell.HorizontalAlignment = 1 And IsNumeric(rCell.Value))
sReturn = "align=""right"""
Case rCell.HorizontalAlignment = xlCenter
sReturn = "align=""center"""
End Select
AlignmentAttr = sReturn
End Function
