Option Base 1 ' sets first array element to 1, not 0

Sub RunExport()
MakeJTable "fintable1", "c:\mydata\", "js_fintable1.js"
MakeJSVars "c:\mydata\"
MsgBox "File created" & vbCrLf & "c:\mydata\js_fintable1.js", vbOKOnly, "RunExport()"
End Sub

Sub MakeJTable(MyTblname As String, MyFileLocn As String, MyFileName As String)
' *** save a single named table as a javascript file ***

' This macro was originally written by Chris Mead (www.meadinkent.co.uk)
' You are free to use it for private use provided this copyright message is left unchanged.

Dim PageName As String, FirstRow As Integer, LastRow As Integer
Dim FirstCol As Integer, LastCol As Integer, MyBold As Byte, MySize As Integer
Dim TempStr As String, MyRow As Integer, MyCol As Integer, InsideTD As String
Dim Vtype As Integer, DefFontSize As Integer, PageStr As String
Dim MergeCount As Integer, MyCell As Range, HL_Locn As String
Dim MyWidths() As Single, TotWidth As Single
Dim MyRngName As Name, StartRng As String

DefFontSize = 10 ' this is the default size on the spreadsheet. Text which is larger or smaller will be modified
If Right(MyFileLocn, 1) <> "\" Then MyFileLocn = MyFileLocn & "\"

For Each MyRngName In Names '   Loop through each named range
 If UCase(MyRngName.Name) = UCase(MyTblname) Then   ' if the range name matches the Table name parameter ...

PageName = MyFileLocn & MyFileName
FirstRow = Range(MyRngName).Row ' *** the range of the worksheet to be   ***
LastRow = Range(MyRngName).Rows.Count + FirstRow - 1 ' *** converted into an HTML table       ***
FirstCol = Range(MyRngName).Column
LastCol = Range(MyRngName).Columns.Count + FirstCol - 1
TotWidth = 0
ReDim MyWidths(LastCol)
For MyCol = FirstCol To LastCol
    MyWidths(MyCol) = Cells(FirstRow, MyCol).ColumnWidth
    TotWidth = TotWidth + MyWidths(MyCol)
   '  Debug.Print MyCol, MyWidths(MyCol)
Next

Open PageName For Output As #1
 PageStr = "document.getElementById('J_" & Left(MyFileName, Len(MyFileName) - 3) & "').innerHTML=" & Chr(34) & "<table><tr>"

'an initial row to set col widths to those on the worksheet
For MyCol = FirstCol To LastCol
PageStr = PageStr & "<th width='" & Format(MyWidths(MyCol) / TotWidth, "0.0%") & "'></th>"
Next MyCol
PageStr = PageStr & "</tr>"
For MyRow = FirstRow To LastRow
PageStr = PageStr & "<tr>"
MyCol = FirstCol
Do While MyCol <= LastCol
Set MyCell = Cells(MyRow, MyCol)    ' sets variable to the current cell

MyBold = 0
MySize = 0
If MyCell.Font.Bold = True Then MyBold = 1
If MyCell.Font.Size > DefFontSize Then MySize = 1
If MyCell.Font.Size < DefFontSize Then MySize = 2

Vtype = 0 ' check whether the cell is numeric
If IsNumeric(MyCell.Value) Then Vtype = 1
If IsDate(MyCell.Value) Then Vtype = 2

If "-" & MyCell.Value & "-" = "--" Then
TempStr = "&nbsp;"  ' a space character to be entered in empty cells
Else

    ' if numeric apply the cell format code
    If Vtype > 0 Then
    TempStr = Format(MyCell.Value, CleanFormat(MyCell.NumberFormat))
    Else
    TempStr = MyCell.Value
    End If
    
    If InStr(1, TempStr, "£") > 0 Then
    TempStr = Replace(TempStr, "£", "&pound;")
    End If
    
    If MyBold = 1 Then
    TempStr = "<b>" & TempStr & "</b>"
    End If
    If MySize = 1 Then
    TempStr = "<big>" & TempStr & "</big>"
    End If
    If MySize = 2 Then
    TempStr = "<small>" & TempStr & "</small>"
    End If
    If MyCell.Font.ColorIndex <> 1 And MyCell.Font.ColorIndex <> -4105 Then
    TempStr = "<font color='" & GetRGB(MyCell.Font.Color) & "'>" & TempStr & "</font>"
    End If

End If

'if cells are merged, count the number of columns. If not merged it will return 1
MergeCount = MyCell.MergeArea.Columns.Count
InsideTD = ChkB(MyRow, MyCol) ' ChkB is a function in this module to set Border commands

If MergeCount > 1 Then
    InsideTD = InsideTD & " align='left' colspan='" & Format(MergeCount, "#") & "'"
    MyCol = MyCol + MergeCount - 1
Else
If Vtype = 2 Then Debug.Print Time(), MyCell.Value, InsideTD, InStr(InsideTD, "align")
    If (Vtype = 1 Or Vtype = 2) And InStr(InsideTD, "align") = 0 Then InsideTD = InsideTD & " align='right'"
End If

TempStr = "<td " & InsideTD & ">" & TempStr & "</td>"

PageStr = PageStr & TempStr
MyCol = MyCol + 1
Loop    ' MyCol

PageStr = PageStr & "</tr>"
Next MyRow

PageStr = PageStr & "</table>"

Print #1, PageStr & Chr(34) & ";"
' an optional footer to appear after each table. If used, delete the previous line of code.
' Print #1, PageStr & "<p><small><font color='#008080'>Table '" & MyTblname & "' generated at " & Format(Now(), "hh:mm ddd dd mmm yy") & "</font></small></p>" & Chr(34) & ";"

Close #1

End If
Next MyRngName

Debug.Print Time(), MyFileLocn & MyFileName, "JS Div ID = J_" & Left(MyFileName, Len(MyFileName) - 3)
End Sub


Sub MakeJSVars(MyFolder As String)
Dim MyFileName As String, MyT As String
 MyFileName = MyFolder & "XLvars.js"
 Open MyFileName For Output As #1

MyT = ActiveWorkbook.FullName
MyT = Replace(MyT, "\", "\\")
  
  Print #1, "var xlfile=" & Chr(34) & MyT & Chr(34) & ";"
  Print #1, "var xlfiletime=" & Chr(34) & Format(Now(), "hh:mm dd mmm yy") & Chr(34) & ";"
  Print #1, "var xlpc=" & Chr(34) & Environ$("computername") & Chr(34) & ";"

 Close #1
 Debug.Print Time, "MakeJSVars()", MyFileName
 End Sub

Function GetRGB(RGB As Long) As String
' convert an Excel colour value into a Hex value suitable for HTML
Dim Red As Integer, Green As Integer, Blue As Integer
    Red = RGB And 255
    Green = RGB \ 256 And 255
    Blue = RGB \ 256 ^ 2 And 255
   GetRGB = "#" & Format(Hex(Red), "00") & Format(Hex(Green), "00") & Format(Hex(Blue), "00")
End Function

Function ChkB(MyRow As Integer, MyCol As Integer) As String
' add borders and table cell properties
Dim Temp As String, MyLine(10) As String, x As Variant
Dim cmW As String, cmS As String
MyLine(7) = "border-left: "
MyLine(8) = "border-top: "

For n = 7 To 8
' left 7 top 8 btm 9 right 10
' Debug.Print GetRGB(Cells(MyRow, MyCol).Borders(n).Color), Cells(MyRow, MyCol).Borders(n).Weight, Cells(MyRow, MyCol).Borders(n).LineStyle

If Cells(MyRow, MyCol).Borders(n).LineStyle = -4142 Then
   MyLine(n) = MyLine(n) & " none; "
Else
    ' weight thick 4 thin 2 medium -4138
    x = Cells(MyRow, MyCol).Borders(n).Weight
    If x = -4138 Then
    cmW = " 1.5pt"
    ElseIf x = 4 Then
    cmW = " 2.5pt"
    Else
    cmW = " 1.0pt"
    End If
    
    ' linestyle 1 solid -4118 dotted -4142 0
    x = Cells(MyRow, MyCol).Borders(n).LineStyle
    If x = -4118 Then
    cmS = " dotted"
    Else
    cmS = " solid"
    End If
    MyLine(n) = MyLine(n) & GetRGB(Cells(MyRow, MyCol).Borders(n).Color) & cmW & cmS & "; "
End If
'Debug.Print MyLine(n)
ChkB = ChkB & MyLine(n)
Next
ChkB = "style ='" & Left(Trim(ChkB), Len(Trim(ChkB)) - 1) & "'"

If ChkB = "style ='border-left:  none; border-top:  none'" Then ChkB = ""

If Cells(MyRow, MyCol).Interior.Color <> 16777215 Then
    ChkB = ChkB & " bgcolor='" & GetRGB(Cells(MyRow, MyCol).Interior.Color) & "'"
End If

If Cells(MyRow, MyCol).HorizontalAlignment = xlHAlignRight Then
    ChkB = ChkB & " align='right'"
End If

If Cells(MyRow, MyCol).HorizontalAlignment = xlHAlignCenter Then
    ChkB = ChkB & " align='center'"
End If
End Function

Function CleanFormat(MyNumCode As String)
Dim xMyNumCode As String, n As Integer, SectCount As Integer
' transform and make a NumberFormat code suitable for Format() function

If MyNumCode = "General" Then
    CleanFormat = "0"
    Exit Function
End If

n = 1
Do While n < Len(MyNumCode)
If Mid(MyNumCode, n, 1) = ";" Then
    SectCount = SectCount + 1
    If SectCount = 2 Then
        MyNumCode = Left(MyNumCode, n) & "0"
        Exit Do
    End If
End If
n = n + 1
Loop

'Debug.Print 2, MyNumCode
n = 1
Do While n < Len(MyNumCode)
If Mid(MyNumCode, n, 1) = "_" Or Mid(MyNumCode, n, 1) = "*" Then
    If n = 1 Then
        MyNumCode = Mid(MyNumCode, 3, 100)
    Else
        MyNumCode = Left(MyNumCode, n - 1) & Mid(MyNumCode, n + 2, 100)
    End If
    n = n - 1
End If
n = n + 1
Loop

' the next 2 lines fix an apparent bug with the Format function in VBA
MyNumCode = Replace(MyNumCode, "0.00,", "0,.00")
MyNumCode = Replace(MyNumCode, "0.0,", "0,.0")

CleanFormat = MyNumCode
End Function