expertatexcel.com

CreateHTMLTableForEmail (html, css,) - coverts spreadsheet visible data to HTML format

Note: change all < to <

Function CreateHTMLtableForEmail(sHeader, Optional r, Optional c)
' This routine will the entire sheet or optional last row (r) and column (c) and convert to HTML table
On Error GoTo eh_chtfe
sBody = "&lt;style>table {border-collaspse Collaspsfont-family:Arial;fint-size:12} th, td {border: 1px solid black;padding: 3px} table {border-collapse: collapse; } th {background-color: silver}&lt;/style>"
If sHeader <> "" Then
    sBody = "&lt;h2>" & sheader & "&lt;/h2>"
End if

sBody = sBody & ""
if IsMissing(r) Then
    c = FindLastCol(1)
    r = FindLastCol(1)
End if

For i = 1 to c
    IF Columns(i).Hidden Then
    Else
        sCols = sCols & Cells(1,i) & ","
    End IF
Next

sCols = Mid(sCols, 1, Len(sCols) - 1)

For j = 1 to C
    If Columns(j).Hidden Then
        j = j
    Else
        px = ColumnWidthToPixels(Cells(1,j).ColumnWidth) '@ is this really needed?
        sBody = sBody & "< col width=""" & px & """ > " & vbCRLF
    End If 


Next

sBody = sBody & "&lt;tr>"
for i = 1 to c
    If Columns(j).Hidden Then
    Else
        sBody = sBody & "< th>" & Cells(1,j) & "< /th>" & vbCRLF
    End If 
Next
sBody = sBody & "< /tr>" & vbCRLF

For i = 2 to r
    Application.Statusbar = i & " of " & r
    If Rows(i).Hidden Then
        'skip
    Else
        sBody = sBody & "< tr>"
        For j = 1 to c
            debug.print c
            If Columns(j).Hidden then
            Else
                sBody = sBody & "< td>" & GetAnchorFromCell(i,j) & "< /td>" & vbCRLF
            End If 
        Next
        sBody = sBody & "< /tr>"
    End If 
Next

CreateHTMLtableForEmail = sBody
Exit Function 
eh_chtfe:
    Stop
    Resume Next
    Resume
End Function