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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
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 code a little cleaner, not because it does anything special.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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 |
Good stuff Dick. Every Excel to HTML function I’ve seen assumes that the text formatting is the same for the ENTIRE cell’s contents. A few years ago I wrote a routine to export formatted text, where the cell contents has mixed formatting. I could never get it to produce valid hmtl with all the tags nested properly. But I never bothered to fix it, since I found I could run the output through a little program called tidy that fixed it every time and created beautifully-formatted, valid html.
TIDY, never heard of it, but here….
http://www.w3.org/People/Raggett/tidy/
“Wot He Sed”…
That’s the first HTML extract I’ve seen that picks out mixed formatting in a single cell.
Now that I come to think of it, there aren’t all that many HTML extractors that cope with merged cells, either.
I had often tried to copy ranges into Outlook email bodies with very mixed results. It rarely produced a result that resembled the original range. Then I came up with a much better and simpler way.
Using a macro I would simply copy the desired range, then using various Sendkeys I basically copy as picture within the email body. Works every time, perfectly, and it’s an exact match of the original range.
Code for converting a range into all kind of formats (CSV. HTML, XML, JPEG, PDF, XPS, etc) can be found here:
http://www.EXCELGAARD.dk/Lib/Range2/
How about using the little-known range value argument for this: range.value(xlRangeValueXMLSpreadsheet) which looks to do some of the work of generating the table structure for you. The result would then need to be transformed using xpath or xslt to get the required HTML out of this.
Hmmm, that’s a new one on me.
I haven’t been around the Excel community since summer 2013. Today I surprised myself to pay a visit here and skim over many articles.
It’s so nice to see that You (Dick) et al continue to keep a high quality level. It stands out as MS Excel blog and other web resources seems to have turned into the endless group of marketing MS Excel.
BTW, it’s high time to turn VBA into open source. In the long run it’s the only option to keep it modern and competitive.
Anyway, keep up the good work guys!
All the best,
Dennis
This is great! I used the Roin de Bruin’s RangetoHTML function for months, but suddenly it crashed with an error I couldn’t fix. These functions helped me keep my applications running, thanks.
I was looking for something like this.. Great code has my work done but only missing with css (like background colors and borders of the table) rest all formatting is great. Can you help with this?
This is amazing, and FAST! But how does one copy borders exactly (not just bottom)? Would appreciate the help!
Instead of
xlEdgeBottom, you can use any of theXlBorderIndexmembers. In the VBE, press F2 to open the Object Explorer. Then type xlEdgeBottom in the search box. That will show you all the possible values for Borders.Works great, cheers.