Excel to HTML Macro

• Download demo project - 15.5 Kb

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>", ">&nbsp;</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.