Showing posts with label Table. Show all posts
Showing posts with label Table. Show all posts

Monday, 22 January 2018

VBA - Excel table to HTML

Just a little routine to help me write these articles. Given an Excel range it will generate the HTML for a table with some subtle (i.e grey) styling.

Option Explicit

Function MarkupTable(ByVal rng As Excel.Range)

    Dim s As String
    s = "<table style='border: 1px solid lightgrey;'>"
    
    Dim rngRowLoop As Excel.Range
    For Each rngRowLoop In rng.Rows
        s = s & "<tr>"
    
        Dim rngCellLoop As Excel.Range
        For Each rngCellLoop In rngRowLoop.Cells
        
            s = s & "<td style='border: 1px solid lightgrey;'>" & rngCellLoop.Value2 & "</td>"
        
        Next rngCellLoop
    
    
        s = s & "</tr>"
    Next
    

    s = s & "</table>"

    MarkupTable = s

End Function

Sub TestMarkupTable()
    Debug.Print MarkupTable(ActiveCell.CurrentRegion)
End Sub

sample

0018095CIAccessibleStatus BarMsoCommandBarStatus Bar
003400F0IAccessibleRibbonMsoCommandBarRibbon
00130E1AITextDocument2CalibriRICHEDIT60WFont Selector?
00140D90ITextDocument211RICHEDIT60WFont size selector?
000E0F54ITextDocument2GeneralRICHEDIT60WFormat selector?
000E034CWindowBook2EXCEL7TrueA window on a workbook

Thursday, 28 December 2017

Convert Excel Table To JSON with VBA and Javascript running on ScriptControl

Today, I am reminded of a SO answer I gave some time ago which serialises an Excel table to JSON. The code is replicated below. I am reminded because it seems there is JavaScript library called SheetJS. SheetJS would require some time to evaluate to see what it is capable of, hopefully I'll blog about it soon. In the meantime, I am re-publishing the code I wrote to show that actually it is quite trivial and need not involve any VBA string operations. Instead, we leverage the JavaScript language and we call into the Excel object model (probably uses COM under the hood) to get each cell's value.

So I would pass in the range to a JavaScript function and let it iterate over the Excel object model and build the array in JavaScript. Then call a JavaScript library to convert array into a string (hat tip Douglas Crockford) and simply return the string to VBA. So no string operations in VBA.

The JavaScript function is given below but depends upon Douglas Crockford's library at https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js. Save this in a file and then amend VBA code with the correct file path so the JavaScript is loaded into the Microsoft Script Control.


function ExcelTableToJSON(rngTable) {
    try {
        if (rngTable && rngTable['Rows'] && rngTable['Columns']) {
            var rowCount = rngTable.Rows.Count;
            var columnCount = rngTable.Columns.Count;
            var arr = new Array();

            for (rowLoop = 1; rowLoop <= rowCount; rowLoop++) {
                arr[rowLoop - 1] = new Array();
                for (columnLoop = 1; columnLoop <= columnCount; columnLoop++) {
                    var rngCell = rngTable.Cells(rowLoop, columnLoop);
                    var cellValue = rngCell.Value2;
                    arr[rowLoop - 1][columnLoop - 1] = cellValue;
                }
            }
            return JSON.stringify(arr);
        }
        else {
            return { error: '#Either rngTable is null or does not support Rows or Columns property!' };
        }
    }
    catch(err) {
        return {error: err.message};
    }
}


Option Explicit

'In response to
'http://stackoverflow.com/questions/38100193/is-it-possible-in-vba-convert-excel-table-to-json?rq=1
'Is it possible in VBA convert Excel table to json

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Private Sub Test()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    oScriptEngine.AddCode GetJavaScriptLibraryFromWeb("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")

    Dim sJavascriptCode As String
    sJavascriptCode = CreateObject("Scripting.FileSystemObject").GetFile("<<<Your file path to javascript file>>>\ExcelTableToJSON.js").OpenAsTextStream.ReadAll

    oScriptEngine.AddCode sJavascriptCode

    Dim rngTable As Excel.Range
    Set rngTable = ThisWorkbook.Worksheets.Item("Sheet2").Range("A1:B2")

    rngTable.Cells(1, 1) = 1.2
    rngTable.Cells(1, 2) = "red"
    rngTable.Cells(2, 1) = True
    rngTable.Cells(2, 2) = "=2+2"


    Dim sStringified As String
    sStringified = oScriptEngine.Run("ExcelTableToJSON", rngTable)
    Debug.Assert sStringified = "[[1.2,""red""],[true,4]]"

    Stop

End Sub

Public Function GetJavaScriptLibraryFromWeb(ByVal sURL As String) As String

    Dim xHTTPRequest As Object 'MSXML2.XMLHTTP60
    Set xHTTPRequest = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibraryFromWeb = xHTTPRequest.responseText

End Function