Option Base 1 ' sets first array element to 1, not 0
Sub MakeHTM_Basic()
' Defining a list of variables used in this program
Dim PageName As String, FirstRow As Integer, LastRow As Integer
Dim FirstCol As Integer, LastCol As Integer, MyBold As Byte
Dim TempStr As String, MyRow As Integer, MyCol As Integer
Dim MyFormats As Variant, Vtype As Integer, MyPageTitle As String
' MyFormats is an array which can contain formats for numbers
' and dates. Add one element for each table column.
MyFormats = Array("", "dd mmm yy", "£#,##0", "0%")
PageName = "d:\tempm.htm" 'location and name of saved file
MyPageTitle = Range("A1").Value
FirstRow = 3 ' the range of the worksheet to be
LastRow = 6 ' converted into an HTML table
FirstCol = 1
LastCol = 4
If UBound(MyFormats) < (LastCol - FirstCol + 1) Then
MsgBox "The 'MyFormats' array has insufficient elements", vbOKOnly + vbCritical, "MakeHTM macro"
Exit Sub
End If
Open PageName For Output As #1
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>Excel to HTML simple table [MeadInKent]</title>"
Print #1, "<style type='text/css'>"
Print #1, "body {font-family: Arial, Helvetica; font-size: 11pt; margin-left: 10; margin-right: 10}"
Print #1, "td {padding: 1pt 3pt 2pt 3pt; border-style: solid; border-width: 1; border-color: #0F5BB9; font-size: 11pt}"
Print #1, "table {border-collapse: collapse; border-width: 1 ; border-style: solid; border-color: #0F5BB9 }"
Print #1, "</style>"
' The next line refers to a cascading style sheet as an alternative to the <style> instructions
' Print #1, "<link rel='stylesheet' type='text/css' href='mikbasic.css'>"
Print #1, "</head>"
Print #1, "<body>"
Print #1, "<h1>" & MyPageTitle & "</h1>"
Print #1, "<table>"
For MyRow = FirstRow To LastRow
Print #1, "<tr>"
For MyCol = FirstCol To LastCol
If Cells(MyRow, MyCol).Font.Bold = True Then
MyBold = 1
Else
MyBold = 0
End If
Vtype = 0 ' check whether the cell is numeric
If IsNumeric(Cells(MyRow, MyCol).Value) Then Vtype = 1
If IsDate(Cells(MyRow, MyCol).Value) Then Vtype = 2
' if numeric and a format code has been created, apply it
If Vtype > 0 And MyFormats(MyCol - FirstCol + 1) <> "" Then
TempStr = Format(Cells(MyRow, MyCol).Value, MyFormats(MyCol - FirstCol + 1))
Else
TempStr = Cells(MyRow, MyCol).Value
End If
If MyBold = 1 Then
TempStr = "<b>" & TempStr & "</b>"
End If
If Vtype = 1 Then ' align numbers (not dates) to the right
TempStr = "<td align='right'>" & TempStr & "</td>"
Else
TempStr = "<td>" & TempStr & "</td>"
End If
' if a table cell is blank, add a space
If TempStr = " <td></td>" Or TempStr = "<td align='right'></td>" Then
TempStr = " <td> </td>"
End If
Print #1, TempStr
Next MyCol
Print #1, "</tr>"
Next MyRow
Print #1, "</table>"
Print #1, "<p>You can search for a name or any detail using [ctrl]+'f'. Press [Home] to<br>"
Print #1, "move to the top of the page. It can be copied and pasted into Excel</p>"
Print #1, "<hr>"
Print #1, "<p><small>Source file: " & ThisWorkbook.Name & " | Page name: " & PageName & " | Created: " & Format(Date, "dd mmm yy") & " | www.MeadInKent.co.uk</small></p>"
Print #1, "</body>"
Print #1, "</html>"
Close #1
MsgBox "The file has been saved as " & PageName, vbOKOnly + vbInformation, "MakeHTML macro"
End Sub
Bookmarks