Excel to HTML Macro
4.92/5 (9 votes)
Aug 24, 2006
3 min read
129830
2432
A simple macro that will convert your Excel data into a clean HTML table.
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()
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Clear listbox contents.
'Me.FileList.RowSource = ""
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Do not allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select a file"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "ASP files", "*.asp"
.Filters.Add ".Net files", "*.aspx"
.Filters.Add "Html files", "*.htm, *.html"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
filePath.Text = varFile
Next
'MsgBox .SelectedItems.Item(0)
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 style or class information is used write
'it to the sorresponding string variable
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 = ""
'used for specific width
If cellWidth = True Then
vbTableWidth = " width:" & Selection.Columns.Width & "; "
End If
'stretch table to 100%
If table100pct = True Then
vbTableWidth = " width:100%; "
End If
vbTableFStyle = " style='" & vbTableWidth & "' "
'Write the table
htmlOut = "<table cellpadding=0 cellspacing=0 border=0 " & _
vbTableId & vbTableStyle & vbTableClass & _
vbTableFStyle & ">" & vbCrLf
' Loop for each row in selection.
For RowCount = 1 To Selection.Rows.Count
' Loop for each column in selection.
htmlOut = htmlOut & "<tr" & vbRowClass & vbRowStyle & ">" & vbCrLf
For ColumnCount = 1 To Selection.Columns.Count
'if the width is fixed then preserve width of each cell
If cellWidth = True Then
vbCellWidth = " width:" & _
Selection.Cells(RowCount, ColumnCount).Width & "; "
Else
vbCellWith = ""
End If
'if checked use font color
If useFontColor = True Then
vbFontColor = " color: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Font.colorIndex) & "; "
Else
vbFontColor = ""
End If
'if checked use background color
If useBGColor = True Then
vbCellBGColor = " background: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Interior.colorIndex) & "; "
Else
vbCellBGColor = ""
End If
'if checked use Bold
If useBold = True Then
If Selection.Cells(RowCount, _
ColumnCount).Font.Bold = True Then
vbBold = " font-weight: bold; "
End If
Else
vbBold = ""
End If
'if checked use italic
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 & "' "
' Write current cell's text
htmlOut = htmlOut & "<td" & vbCellClass & vbCellStyle _
& vbCellFStyle & ">" & Selection.Cells(RowCount, _
ColumnCount).Text & "</td>"
' Check if cell is in last column.
If ColumnCount = Selection.Columns.Count Then
' If so, then write a blank line.
htmlOut = htmlOut & vbCrLf
End If
' Start next iteration of ColumnCount loop.
Next ColumnCount
' Start next iteration of RowCount loop.
htmlOut = htmlOut & "</tr>" & vbCrLf
Next RowCount
htmlOut = htmlOut & "</table>" & vbCrLf
'force rendering of empty cells
If emptyCell = True Then htmlOut = Replace(htmlOut, "></td>", "> </td>")
'Writing HTML to file if checked
If Trim(filePath.Text) <> "" Then
DestFile = filePath.Text
' Obtain next free file handle number.
FileNum = FreeFile()
' Turn error checking off.
On Error Resume Next
' Attempt to open destination file for output.
Open DestFile For Output As #FileNum
' If an error occurs report it and end.
If Err <> 0 Then
MsgBox Err.Description
MsgBox "Cannot open filename " & DestFile
End
Else
Print #FileNum, htmlOut;
' Close destination file.
Close #FileNum
End If
End If
' Turn error checking on.
On Error GoTo 0
'if checked copy HTML to clipboard
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
'a lookup table to convert a ColorIndex value
'to its Hex equivilant
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.