You probably know that you can save an Excel workbook in HTML format. I do it for my golf league and it works fine. It also generates a pig of an HTML file, mainly because Microsoft is trying to have high fidelity (make it look the same in the browser as it does in the desktop).
For my most recent sports-related project, I just didn’t want such a large file. I run an NFL survivor pool. You can read all the rules if you like, but basically each participant selects one NFL team per week. If that team wins, the participant survives. If they lose, they’re done. Whoever is left at the end is the winner. I needed a quick and easy way to update the results on a web page.
I start with this spreadsheet:
Bold teams means a loss. Italicized teams are winners. Unformatted teams means they haven’t played yet (or I haven’t updated yet). The end result is this:
I found a bunch of images of NFL helmets and a free green checkmark image on the interwebs. Now all I have to do is read the data and convert it to HTML. Here’s the code:
Sub MakeHmtl()
Dim rRow As Range
Dim rCell As Range
Dim sHtml As String
Dim sBody As String
Dim sTable As String
Dim sRow As String
Dim bLoss As Boolean
Dim lFnum As Long
Dim sFname As String
Const sPAIDIMG As String = ""
'header
sHtml = Tag("DK Survivor Pool", "title") & vbNewLine
sHtml = sHtml & ""
sHtml = Tag(sHtml, "head", , True) & vbNewLine
'body
sBody = Tag("DK Survivor Pool", "h1") & vbNewLine
sBody = sBody & Tag("Updated: " & Format(Now, "yyyy-mmm-dd hh:mm AM/PM"), "p") & vbNewLine
sBody = sBody & Tag(Tag("Rules", "a", "href = ""survivorrules.html"""), "p") & vbNewLine
'table
For Each rRow In Sheet1.Range("A2:S13").Rows
bLoss = False
For Each rCell In rRow.Cells
If rCell.Column = 1 Or rCell.Row = 2 Then
sRow = sRow & AddClass(Tag(rCell.Value, "td"), "name")
ElseIf rCell.Column = 2 Then
If IsEmpty(rCell.Value) Then
sRow = sRow & Tag("", "td")
Else
sRow = sRow & Tag(sPAIDIMG, "td")
End If
Else
Select Case True
Case rCell.Font.Bold
sRow = sRow & AddClass(Tag(MakeImage(rCell.Value), "td"), "loss")
bLoss = True
Case rCell.Font.Italic
sRow = sRow & AddClass(Tag(MakeImage(rCell.Value), "td"), "win")
Case IsEmpty(rCell.Value)
If bLoss Then
sRow = sRow & AddClass(Tag("", "td"), "loss")
Else
sRow = sRow & Tag("", "td")
End If
Case Else
sRow = sRow & Tag(MakeImage(rCell.Value), "td")
End Select
End If
Next rCell
sTable = sTable & Tag(sRow, "tr") & vbNewLine
sRow = """"
Next rRow
sBody = sBody & Tag(sTable, "table", "border=""1"" cellpadding=""5""", True)
sHtml = sHtml & Tag(sBody, "body", , True)
sHtml = Tag(sHtml, "html", , True)
If Len(Dir("C:Test_Datadebug.ini")) = 0 Then
sFname = "C: UsersdickDropboxSportsSurvivorindex.html"""
Else
sFname = "C:UsersdickMy DocumentsMy DropboxSportsSurvivorindex.html"""
End If
lFnum = FreeFile
Open sFname For Output As lFnum
Print #lFnum, sHtml
Close lFnum
End Sub
Creating text files from scratch can be a pain in the butt, but HTML files are worse. You have to get all those tags right and properly closed. I hate unindented HTML, so there’s more work there too. Generally I try to work from the inside out on HTML files. That way I can a pass a couple of arguments into a function to make the tags and be assured that I don’t miss something. Take the header section for example. First I pass “DK Survivor Pool” and “title” into the Tag function. That 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
(WordPress doesn’t like HTML so there’s an extra space in the closing tag part.) I get back something that looks like this
Next, I append the link tag manually because it doesn’t really fit into my inside-out dynamic. Finally, I call sHtml = Tag(sHtml, "head", , True) & vbNewLine to wrap what I have in a head tag. I also set the optional Indent argument to true and get this:
The code wraps whatever I send it, in whatever tag I send it, and indents along the way. The other optional argument is for including attributes within the tag. I want my table tag to have border=”1″ and cellpadding=”5″ so I supply those to the function when needed. I use the class attribute a lot to format winners and losers. I created a separate function to add a class attribute so I wouldn’t have to type it in the code.
Function AddClass(sTag As String, sClass As String) As String
AddClass = Replace(sTag, ">", " class=""" & sClass & """>", 1, 1)
End Function
The last helper function is to create an image tag. My Tag function is good for enclosing something in opening and closing tags. The image tag is self-closing, so it gets its own home. On the spreadsheet, I record the team name so that it matches the image file name. If I type “eagles” for a Philadelphia pick, the MakeImage function returns 
Function MakeImage(sValue As String) As String
MakeImage = ""
End Function
The main code basically loops through all the cells, determines the HTML necessary, and appends it to one long string. That string is then written to a file. Once complete, I manually FTP that file up to my web server. A couple of other notes on the code:
Losing teams are colored red and that participant doesn’t get to select any more. I wanted all the succeeding weeks to be red also. I use the bLoss variable to handle this. When I get to a loss, I set bLoss to True. When an empty cell is detected (no selection yet), I add the “loss” class to the td tag to color it red.
The last part is the location of the file. My dropbox folder is in two different places on two different computers. I’m not sure why this is, but I think it relates to which operating system was installed when I installed Dropbox. Back in the Windows XP days, Dropbox put it in My DocumentsMy Dropbox and in Windows 7, it’s directly under the user folder and they dropped the “My”. At least I think that’s what happened. To differentiate the two, I found a file that I’m absolutely sure is on one computer and absolutely sure isn’t on the other. I use Len(Dir(..)) to test the existence of the file and change the path accordingly. I think we both know this will break some time in the future, but it works for now.
One of the downsides to the inside-out approach for concatenating HTML is code readability. If I’m just building a string one character at a time, it’s pretty easy to follow along. When I use functions to wrap strings in tags, it’s a little harder. You might expect that the html opening tag would be near the top of the procedure, but it’s actually the last tag I add because it’s “outside”.
Finally, if you’re new to creating big strings in VBA, you should note that to embed a double quote into a string, you use two double quotes in succession.
Don’t know if you considered the use of a XML library or not.
Since HTML is a type of XML, how about using the MSXML library to generate the document? For examples search Google (or Bing if you prefer) for ‘vba create xml’ (you know what to do with the quotes {grin}). One example, albeit simplistic, is at http://www.freevbcode.com/ShowCode.asp?ID=1919
I imagine a realistic solution will probably be recursive. An example of reading a XML document is at http://msdn.microsoft.com/en-us/library/aa468547.aspx
I agree, the use of XML for the data, and an XSLT stylesheet and MSXML to reformat the data into a HTML file, will greatly reduce these lines of code to <20 lines.
That would be pretty neat to see a comparison done with XML vs the way Kusleika did it. I don’t think I’ll spend the time on it though, so if anyone does it, let me know so I can see what the comparison would be.
The code below uses the MS XML library to convert a worksheet into a HTML document. It includes the capability of adding images in place of cell values. Functionally, it is along the lines of the original post though it is missing some elements. However, it includes enough capabilities that it should be easily adaptable to the original task.
‘To pretty print see http://msdn.microsoft.com/en-us/library/ms753769.aspx
‘Pre-requisite is a reference to Microsoft XML
Sub setAttributes(Obj As IXMLDOMElement, ParamArray AttrList())
Dim I As Integer
For I = LBound(AttrList) To UBound(AttrList) Step 2
Obj.setAttribute AttrList(I), AttrList(I + 1)
Next I
End Sub
Sub createDoc()
Dim aDoc As MSXML2.DOMDocument: Set aDoc = New MSXML2.DOMDocument
aDoc.preserveWhiteSpace = True
Dim RootELe As MSXML2.IXMLDOMElement: Set RootELe = aDoc.createElement(“html”)
aDoc.appendChild RootELe
Dim HeadEle As IXMLDOMElement
Set HeadEle = RootELe.appendChild(aDoc.createElement(“head”))
Dim StyleLink As IXMLDOMElement
Set StyleLink = HeadEle.appendChild(aDoc.createElement(“link”))
setAttributes StyleLink, “rel”, “stylesheet”, “type”, “text/css”, “href”, “my_style.css”
Dim BodyEle As IXMLDOMElement: Set BodyEle = RootELe.appendChild(aDoc.createElement(“body”))
Dim TableEle As IXMLDOMElement
Set TableEle = BodyEle.appendChild(aDoc.createElement(“table”))
Dim I As Long
With ActiveSheet.UsedRange
For I = 1 To .Rows.Count
Dim RowEle As IXMLDOMElement
Set RowEle = TableEle.appendChild(aDoc.createElement(“tr”))
Dim J As Long
For J = 1 To .Columns.Count
Dim CellEle As IXMLDOMElement
Set CellEle = RowEle.appendChild(aDoc.createElement(“td”))
With .Cells(I, J)
If IsEmpty(.Value) Then
CellEle.Text = ” “
Else
Dim ImgEle As IXMLDOMElement
Set ImgEle = aDoc.createElement(“img”)
setAttributes ImgEle, “src”, .Value & “left.bmp”, “alt”, .Value
CellEle.appendChild ImgEle
End If
If .Font.Bold Then CellEle.setAttribute “class”, “loss”
If .Font.Italic Then CellEle.setAttribute “class”, “win”
End With
Next J
Next I
End With
aDoc.Save “c: empxmltest.htm”
End Sub
I have very little knowledge about XML. Thanks for sharing
“One of the downsides to the inside-out approach for concatenating HTML is code readability. If I’m just building a string one character at a time, it’s pretty easy to follow along. When I use functions to wrap strings in tags, it’s a little harder. You might expect that the html opening tag would be near the top of the procedure, but it’s actually the last tag I add because it’s “outside”.”
In addition to the MSXML approach, here’s another way of doing this from the ‘top to the bottom.’ Use a stack to save the ending tags and when ready pop the stack.
The below if a functional example.
‘Should put the stack stuff in a class!
Dim Stack() As String, TopOfStack As Integer
Sub initStack()
ReDim Stack(9)
TopOfStack = LBound(Stack) – 1
End Sub
Sub pushStack(Item)
If TopOfStack = UBound(Stack) Then _
ReDim Preserve Stack(UBound(Stack) + 10)
TopOfStack = TopOfStack + 1
Stack(TopOfStack) = Item
End Sub
Function popStack()
popStack = Stack(TopOfStack)
TopOfStack = TopOfStack – 1
End Function
Sub addTag(ByRef Rslt As String, Tag As String)
Rslt = Rslt & “<“ & Tag & “>”
pushStack “</” & Tag & “>”
End Sub
Sub doStuff()
Dim Rslt As String
initStack
addTag Rslt, “html”
addTag Rslt, “head”
Rslt = Rslt & “<!– This is a comment within the head tag –>”
Rslt = Rslt & popStack()
addTag Rslt, “body”
addTag Rslt, “p”
Rslt = Rslt & “Hello there”
Rslt = Rslt & popStack()
Rslt = Rslt & popStack()
Rslt = Rslt & popStack()
Debug.Print Rslt
End Sub
Depending on how the initial raw data is stored in the workbook, using XML and XSLT Stylesheets within VBA would produce more elegant results.
Create a table in a worksheet and map it to an XML Schema .xsd file from the “Source” button on the XML section on the developer tab. The data can then be exported to an xml file as below. Use the MS Excel XML Toolbox to create and assign a Schema file to the set of data to be exported. – http://www.microsoft.com/download/en/details.aspx?id=21031
John
12.5
Anne
48.2
Steven
58.4
Create an XSLT stylesheet, with a name of formatTable.xsl, as below. The stylesheet will loop thru the data in the xml file and format as a simple html table with a conditional check on the data stored in the Value element and format with appropriate colour.
body * {font-family:Verdana;font-size:8pt}
th {background:#525252;color:#f2f2f2;text-align:left}
td {border-bottom:1px solid #999}
td.red {background:red}
td.green {background:yellowgreen}
Name
Value
Insert a new module into the workbook and use the VBA procedure below
Option Explicit
Public Sub sbConvertData()
‘Pre-requisite is a reference to Microsoft XML 6.0
Dim oXML As New MSXML2.DOMDocument30
Dim oXSL As New MSXML2.DOMDocument30
Dim sXML As String
Dim sDataFile As String
Dim sStylesheetFile As String
Dim sResultFile As String
Dim bLoaded As Boolean
ThisWorkbook.XmlMaps(1).Export ThisWorkbook.Path & Application.PathSeparator & “data.xml”, True
sDataFile = ThisWorkbook.Path & Application.PathSeparator & “data.xml”
sStylesheetFile = ThisWorkbook.Path & Application.PathSeparator & “formatTable.xsl”
sResultFile = ThisWorkbook.Path & Application.PathSeparator & “result.html”
‘Load asynchronously
oXML.async = False
oXSL.async = False
‘Load XML
bLoaded = oXML.Load(sDataFile)
If Not bLoaded Then
MsgBox oXML.parseError.Line & vbTab & oXML.parseError.reason, vbExclamation + vbOKOnly
GoTo HandleExit
End If
bLoaded = oXSL.Load(sStylesheetFile)
If Not bLoaded Then
MsgBox oXSL.parseError.Line & vbTab & oXSL.parseError.reason, vbExclamation + vbOKOnly
GoTo HandleExit
End If
sXML = oXML.transformNode(oXSL)
Open sResultFile For Output As #1
Print #1, sXML
Close #1
HandleExit:
‘Check if object exists as release
If Not oXML Is Nothing Then Set oXML = Nothing
If Not oXSL Is Nothing Then Set oXSL = Nothing
Exit Sub
HandleError:
MsgBox Err.Number & vbTab & Err.Description, vbExclamation + vbOKOnly
Resume HandleExit
End Sub
The resulting HTML file will show the data exported and formatted into a table.
oops….looks like the stylesheet and xml did not save properly…
XML Data File:
<Root xmlns:xsi=”http://www.w3.org/2001/XMLSchema-instance”>
<Row>
<Name>John</Name>
<Value>12.5</Value>
</Row>
<Row>
<Name>Anne</Name>
<Value>48.2</Value>
</Row>
<Row>
<Name>Steven</Name>
<Value>58.4</Value>
</Row>
</Root>
Stylesheet file
<xsl:stylesheet version=“1.0” xmlns:xsl=“http://www.w3.org/1999/XSL/Transform”>
<xsl:output method=“html” indent=“yes” encoding=“UTF-8”/>
<xsl:template match=“/”>
<html>
<head>
<style type=“text/css”>
body * {font-family:Verdana;font-size:8pt}
th {background:#525252;color:#f2f2f2;text-align:left}
td {border-bottom:1px solid #999}
td.red {background:red}
td.green {background:yellowgreen}
</style>
</head>
<body>
<table cellpadding=“6” cellspacing=“1”>
<tr>
<th>Name</th>
<th>Value</th>
</tr>
<xsl:for-each select=“//Row”>
<xsl:sort select=“Name” data-type=“text” order=“ascending” />
<tr>
<td>
<xsl:value-of select=“Name” />
</td>
<xsl:choose>
<!– Use > as a replacement for greater than symbol –>
<xsl:when test=“Value>20”>
<td class=“red”>
<xsl:value-of select=“Value” />
</td>
</xsl:when>
<xsl:otherwise>
<td class=“green”>
<xsl:value-of select=“Value” />
</td>
</xsl:otherwise>
</xsl:choose>
</tr>
</xsl:for-each>
</table>
</body>
</html>
</xsl:template>
</xsl:stylesheet>
I have a similar pool, but have kept from publishing on the web mainly because I have many macros running analysis on the data. Though simply publishing results in html might be pretty good way for people to keep track. I’ve had numerous requests to put my survivor pool on the web.
From your original example it’s not clear where/how the source images are located and assigned to the data. Can you tell me how your source files match up with the team logo/picture? I don’t read it in your code.
– RV
The images are in the same directory as index.html – I ftp’d them up there. The are all named teammascotleft.bmp. So the Chicago helmet is named bearsleft.bmp. The MakeImage function makes an image tag that looks like
Since there’s not path in the src argument, it looks in the same directory as the file with the img tag.
Also, you’ll notice that when I record the picks in Excel, I use the lower case team mascot name. I have to do this because it builds the image tag from the cell value.