Introduction
This macro is designed to take the highlighted cells of an Excel spreadsheet and create a simple HTML table to display the output.
Background
I wrote this out of necessity for my job because I was unable to find code that did what I needed. What differentiates my approach from the other Excel to HTML converters I have seen is that many others take the approach of making the generated web page look as much like the spreadsheet as possible. I wanted this to make it easy to create a web page that looked like it belonged on my website not in MS Office.
For me, this means that it is flexible enough to be able to insert my stylesheet information and other properties and not have any of the garbage HTML that Microsoft likes to put in their pages. Also, I only cared about the output of the cell, not any underlying formula that generated the text. In other words, I wanted simple clean static HTML.
Using the code
There are a couple of ways to install the code. The simplest is to copy it to the C:\Documents and Settings\<USER>\Application Data\Microsoft\Excel\XLSTART directory. This will make the macro available by opening the file anytime Excel opens, by clicking on Tools > Macro > macros, and selecting the exportHTML macro. A much nicer way is to convert it to an add-in and then assign the macro to a custom button. Go to the Microsoft website to see how to do this for your version of Office.
The basic idea is that the macro writes a string of HTML based on the selection of cells. Any user input by way of the form is incorporated into the HTML. Any style information inserted into the rows or columns will be inserted into every row or column generated by the script. Also, the default behavior is to copy the HTML to the clipboard. You have the ability to write the HTML to a file by going to the Options tab and selecting the file. This will overwrite the file.
Here is the code. It makes more sense when you are looking at the form and its properties.
Private Sub cellWidth_Change()
If cellWidth.Value = True Then table100pct.Value = False
End Sub
Private Sub findFile_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select a file"
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "ASP files", "*.asp"
.Filters.Add ".Net files", "*.aspx"
.Filters.Add "Html files", "*.htm, *.html"
If .Show = True Then
For Each varFile In .SelectedItems
filePath.Text = varFile
Next
End If
End With
End Sub
Private Sub makeHTML_Click()
Dim DestFile As String
Dim htmlOut As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim vbTableWith As String
Dim vbTableFStyle As String
Dim vbCellWith As String
Dim vbCellBGColor As String
Dim vbCellFStyle As String
Dim vbFontColor As String
Dim vbBold As String
Dim vbItalic As String
Dim outputObj As New DataObject
If Trim(tableStyle.Text) <> "" Then
vbTableStyle = " style='" & tableStyle.Text & "' "
Else
vbTableStyle = ""
If Trim(tableClass.Text) <> "" Then
vbTableClass = " class='" & tableClass.Text & "' "
Else
vbTableClass = ""
If Trim(tableId.Text) <> "" Then
vbTableId = " id='" & tableId.Text & "' "
Else
vbTableId = ""
If Trim(rowStyle.Text) <> "" Then
vbRowStyle = " style='" & rowStyle.Text & "' "
Else
vbRowStyle = ""
If Trim(rowClass.Text) <> "" Then
vbRowClass = " class='" & rowClass.Text & "' "
Else
vbRowClass = ""
If Trim(cellStyle.Text) <> "" Then
vbCellStyle = " style='" & cellStyle.Text & "' "
Else
vbCellStyle = ""
If Trim(cellClass.Text) <> "" Then
vbCellClass = " class='" & cellClass.Text & "' "
Else
vbCellClass = ""
If cellWidth = True Then
vbTableWidth = " width:" & Selection.Columns.Width & "; "
End If
If table100pct = True Then
vbTableWidth = " width:100%; "
End If
vbTableFStyle = " style='" & vbTableWidth & "' "
htmlOut = "<table cellpadding=0 cellspacing=0 border=0 " & _
vbTableId & vbTableStyle & vbTableClass & _
vbTableFStyle & ">" & vbCrLf
For RowCount = 1 To Selection.Rows.Count
htmlOut = htmlOut & "<tr" & vbRowClass & vbRowStyle & ">" & vbCrLf
For ColumnCount = 1 To Selection.Columns.Count
If cellWidth = True Then
vbCellWidth = " width:" & _
Selection.Cells(RowCount, ColumnCount).Width & "; "
Else
vbCellWith = ""
End If
If useFontColor = True Then
vbFontColor = " color: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Font.colorIndex) & "; "
Else
vbFontColor = ""
End If
If useBGColor = True Then
vbCellBGColor = " background: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Interior.colorIndex) & "; "
Else
vbCellBGColor = ""
End If
If useBold = True Then
If Selection.Cells(RowCount, _
ColumnCount).Font.Bold = True Then
vbBold = " font-weight: bold; "
End If
Else
vbBold = ""
End If
If useItalic = True Then
If Selection.Cells(RowCount, _
ColumnCount).Font.Italic = True Then
vbItalic = " font-style: italic; "
End If
Else
vbItalic = ""
End If
vbCellFStyle = " style='" & vbFontColor & vbCellWidth _
& vbCellBGColor & vbBold & vbItalic & "' "
htmlOut = htmlOut & "<td" & vbCellClass & vbCellStyle _
& vbCellFStyle & ">" & Selection.Cells(RowCount, _
ColumnCount).Text & "</td>"
If ColumnCount = Selection.Columns.Count Then
htmlOut = htmlOut & vbCrLf
End If
Next ColumnCount
htmlOut = htmlOut & "</tr>" & vbCrLf
Next RowCount
htmlOut = htmlOut & "</table>" & vbCrLf
If emptyCell = True Then htmlOut = Replace(htmlOut, "></td>", "> </td>")
If Trim(filePath.Text) <> "" Then
DestFile = filePath.Text
FileNum = FreeFile()
On Error Resume Next
Open DestFile For Output As #FileNum
If Err <> 0 Then
MsgBox Err.Description
MsgBox "Cannot open filename " & DestFile
End
Else
Print #FileNum, htmlOut;
Close #FileNum
End If
End If
On Error GoTo 0
If copyClipboard.Value = True Then
outputObj.SetText (htmlOut)
outputObj.PutInClipboard
End If
End
End Sub
Private Sub table100pct_Change()
If table100pct.Value = True Then cellWidth.Value = False
End Sub
Private Function index2Hex(index)
Dim hexColor As String
Dim colorTable(56) As String
colorTable(1) = "#000000"
colorTable(2) = "#FFFFFF"
colorTable(3) = "#FF0000"
colorTable(4) = "#00FF00"
colorTable(5) = "#0000FF"
colorTable(6) = "#FFFF00"
colorTable(7) = "#FF00FF"
colorTable(8) = "#00FFFF"
colorTable(9) = "#800000"
colorTable(10) = "#008000"
colorTable(11) = "#000080"
colorTable(12) = "#808000"
colorTable(13) = "#800080"
colorTable(14) = "#008080"
colorTable(15) = "#C0C0C0"
colorTable(16) = "#808080"
colorTable(17) = "#9999FF"
colorTable(18) = "#993366"
colorTable(19) = "#FFFFCC"
colorTable(20) = "#CCFFFF"
colorTable(21) = "#660066"
colorTable(22) = "#FF8080"
colorTable(23) = "#0066CC"
colorTable(24) = "#CCCCFF"
colorTable(25) = "#000080"
colorTable(26) = "#FF00FF"
colorTable(27) = "#FFFF00"
colorTable(28) = "#00FFFF"
colorTable(29) = "#800080"
colorTable(30) = "#800000"
colorTable(31) = "#008080"
colorTable(32) = "#0000FF"
colorTable(33) = "#00CCFF"
colorTable(34) = "#CCFFFF"
colorTable(35) = "#CCFFCC"
colorTable(36) = "#FFFF99"
colorTable(37) = "#99CCFF"
colorTable(38) = "#FF99CC"
colorTable(39) = "#CC99FF"
colorTable(40) = "#FFCC99"
colorTable(41) = "#3366FF"
colorTable(42) = "#33CCCC"
colorTable(43) = "#99CC00"
colorTable(44) = "#FFCC00"
colorTable(45) = "#FF9900"
colorTable(46) = "#FF6600"
colorTable(47) = "#666699"
colorTable(48) = "#969696"
colorTable(49) = "#003366"
colorTable(50) = "#339966"
colorTable(51) = "#003300"
colorTable(52) = "#333300"
colorTable(53) = "#993300"
colorTable(54) = "#993366"
colorTable(55) = "#333399"
colorTable(56) = "#333333"
If index = xlColorIndexNone Then index = 2
If index = xlColorIndexAutomatic Then index = 1
hexColor = colorTable(index)
index2Hex = hexColor
End Function
Points of interest
This was an amazingly simple piece of code that I had a lot of fun making. It has proved immensely valuable to me as a web developer. I haven�t tested it on older Office versions, but I think any changes would be simple to implement. I hope I have time to come back and make improvements to the code, but if you beat me to it, drop me a line and let me see what you have done with it. Some suggestions are to:
- Automate the script to run on all Excel files inside of a folder or all worksheets in a file.
- Be able to preview and change style information on individual cells or rows prior to writing the final HTML.
- Colspans and rowspans.
- Any DHTML behaivior you can think of.
- A simple change would be to optionally alternate the background color of rows in the table.