With the code below you can export values or formulas from a worksheet range to a HTML-file:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 |
Option Explicit Sub this_starts_the_example() ' Adjust the range and the file location ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True End Sub Sub ExportRangeAsHTML(SourceRange As Range, TargetFile As String, _ TableSize As String, UseRangeColumnWidths As Boolean, _ TableBorderSize As Integer, CellPadding As Integer, _ CellSpacing As Integer, IncludeEmptyCells As Boolean) ' Exports the data in SourceRange to the textfile TargetFile in HTML format ' Adjust to your needs ' Example: ExportRangeAsHTML Range("A1:F20"), "C:\temp\textfile.html", "", True, 1, 5, 0, True Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long Dim fn As Integer, LineString As String, tLine As String, CellColumnWidth As Long Dim BoldCell As Boolean, ItalicCell As Boolean, CellAlignment As Integer ' validate the input data if necessary If SourceRange Is Nothing Then Exit Sub If Len(TargetFile) = 0 Then Exit Sub If Application.WorksheetFunction.CountA(SourceRange) = 0 Then If Not IncludeEmptyCells Then Exit Sub End If On Error Resume Next Kill TargetFile On Error GoTo 0 If Len(Dir(TargetFile)) > 0 Then MsgBox TargetFile & " already exists, rename, move Or delete the file before you try again.", vbInformation, "Export range To textfile" Exit Sub End If ' perform export On Error GoTo NotAbleToExport fn = FreeFile Open TargetFile For Append As #fn ' open textfile for new input On Error GoTo 0 ' determine the total number of rows to process totr = 0 For A = 1 To SourceRange.Areas.Count totr = totr + SourceRange.Areas(A).Rows.Count Next A ' start the HTML file Print #fn, "<html>" Print #fn, "<head>" Print #fn, "<meta name=""DESCRIPTION"" content=""Description of content"">" Print #fn, "<meta name=""KEYWORDS"" content=""Keywords"">" Print #fn, "<title>Range To HTML from " & ActiveWorkbook.Name & "</title>" Print #fn, "</head>" Print #fn, Print #fn, "<body>" Print #fn, "<h1>Range To HTML from " & ActiveWorkbook.Name & "</h1>" Print #fn, If TableSize = "" Then Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """>" Else Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """ width=""" & TableSize & """>" End If ' start writing the HTML-file pror = 0 For A = 1 To SourceRange.Areas.Count For r = 1 To SourceRange.Areas(A).Rows.Count If pror Mod 50 = 0 Then Application.StatusBar = "Writing the HTML-file " & Format(pror / totr, "0 %") & "..." End If Print #fn, " <tr>" For c = 1 To SourceRange.Areas(A).Columns.Count LineString = " " CellAlignment = 0 tLine = "" On Error Resume Next With SourceRange.Areas(A).Cells(r, c) tLine = Trim(.Text) BoldCell = .Font.Bold ItalicCell = .Font.Italic CellAlignment = .HorizontalAlignment End With On Error GoTo 0 If (tLine = "" Or tLine = " ") And IncludeEmptyCells Then tLine = " " If tLine <> "" Then LineString = LineString & "<td" If UseRangeColumnWidths Then CellColumnWidth = CLng(Cells(1, c + 1).Left - Cells(1, c).Left) LineString = LineString & " width=""" & CellColumnWidth & """" End If If CellAlignment = xlHAlignGeneral Then Select Case Asc(tLine) Case 45, 48 To 57 CellAlignment = xlHAlignRight End Select End If If CellAlignment = xlHAlignCenter Then LineString = LineString & " align=""center""" If CellAlignment = xlHAlignRight Then LineString = LineString & " align=""right""" LineString = LineString & ">" If BoldCell Then LineString = LineString & "<b>" If ItalicCell Then LineString = LineString & "<i>" LineString = LineString & tLine If ItalicCell Then LineString = LineString & "</i>" If BoldCell Then LineString = LineString & "</b>" LineString = LineString & "</td>" Print #fn, LineString End If Next c Print #fn, " </tr>" pror = pror + 1 Next r Next A ' end the HTML file Print #fn, "</table>" Print #fn, Print #fn, "</body>" Print #fn, "</html>" Close #fn ' close the targetfile NotAbleToExport: Set SourceRange = Nothing Application.StatusBar = False End Sub |
Example of a worksheet range with random data.
Result, the basic HTML table.
