Sub html_code()

'Code Written By: 
'     Brian Greenberg
'     brian@familygreenberg.com
'     http://www.familygreenberg.com
'     http://www.familygreenberg.com/blog.htm
' 
'     This code is provided free of charge for anyone who wishes to use it,
'     provided the attribution above remains intact, and no finanical profit is gleaned
'     from it.
' 
'     If you have questions about using the code, please send the author an e-mail at
'     brian@familygreenberg.com
' 
'Usage:
'       Highlight a range
'
'       Run macro to create the basic html for the table.
'
'       Copy & paste the code into a text editor and add borders, widths, fonts, colors, etc.

Application.ScreenUpdating = False

'Establish the height, width, and the four corners of the selected range
sel_rng = Selection()
If Selection.Count > 1 Then rng_height = UBound(sel_rng, 1) Else rng_height = 1
If Selection.Count > 1 Then rng_width = UBound(sel_rng, 2) Else rng_width = 1
Set ul_rng = ActiveCell()
Set ll_rng = ActiveCell().Offset(rng_height - 1, 0)
Set ur_rng = ActiveCell().Offset(0, rng_width - 1)
Set lr_rng = ActiveCell().Offset(rng_height - 1, rng_width - 1)

'Check for widths
spec_width = MsgBox("Would you like to specify column widths?", vbYesNo, "Column Widths?")

If spec_width = vbYes Then
    Dim widths(50)
    For i = 0 To rng_width - 1
        widths(i) = InputBox("Enter width for column " + CStr(i + 1), "Enter Width")
    Next i
End If

'Start html code string
result = "<TABLE BORDER=1>"

'Nested Loop to go through the table - columns first, then rows
For i = 0 To rng_height - 1
    result = result + "<TR>"
    For j = 0 To rng_width - 1
        ul_rng.Offset(i, j).Select
        result = result + "<TD"
        If spec_width = vbYes Then result = result + " WIDTH=" + widths(j)
        result = result + ">"
        If Selection.Font.Bold = True Then result = result + "<B>"
        If Selection.Font.Italic = True Then result = result + "<I>"
        result = result + CStr(Selection.Value)
        If Selection.Font.Bold = True Then result = result + "</B>"
        If Selection.Font.Italic = True Then result = result + "</I>"
        result = result + "</TD>"
    Next j
    result = result + "</TR>"
Next i
result = result + "</TABLE>"

Dim result_object As DataObject
Set result_object = New DataObject
result_object.SetText result
result_object.PutInClipboard

x = MsgBox(result, vbOKOnly, "The following code has been put in the clipboard:")

End Sub