Soft Links assist with Hard Link Hell

If you build an Excel application of any size then you will probably use more than one workbook. To access information in another workbook the standard way is to link. However, having workbooks linked to one another often leads to problems managing the opening and closing of linked workbooks. In this post I offer a 'soft link' which aims to break the hard links which come as a default and let your code take control.

There is such a thing as dependency hell where it required to gather antecedent code or data. A specific instance on Windows is DLL Hell concerning the loading of correct executable libraries. In Excel, we have our own form which I am calling 'Hard Link Hell'.

I call Hard Link Hell the mess that VBA coders can encounter when we build a VBA application of size that spans multiple workbooks. In my opinion, a VBA coder ought to exercise as much control as possible over the opening and closing of workbooks. Have a cell in one workbook link to another raises the spectre of Excel opening linked workbooks when we were not expecting it.

Admittedly, there is some control over the behaviour. So from the Data ribbon if I select Edit Links then I get the following dialog box...

... where we can see in the bottom right corner the Startup Prompt button which if pressed raises the following dialog ...

Nevertheless, I have had Hard Link Hell in the past where I have had the break links and relink to a new workbook. I remember it being a nightmare. So, in this post I give some code called Soft Links which means VBA code can take control of when to open linked workbooks. The code ships two functions to be called from a worksheet, SoftLink(workbookName, sheetName, rangeName) which actually return an Excel.Range object but Excel is clever enough to call the Value property; but this works only for single cell references. So for multiple cells use SoftLinkValue(workbookName, sheetName, rangeName). Be aware that the source cell(s) must be named using a range name. Also in the listing are some test procedures

Note, you will have to write code to open the source workbooks or you will get a #VALUE!, but we wanted to take control and so comes the responsibility to ensure the source workbook is loaded when this function is calculated. Enjoy!

Option Explicit

'* Use this for a source comprising multiple cells
Public Function SoftLinkValue(ByVal sWorkbookName As String, ByVal sSheetName As String, ByVal sRangeName As String)
    Dim rng As Excel.Range
    Set rng = SoftLink(sWorkbookName, sSheetName, sRangeName)
    SoftLinkValue = rng.Value
End Function

'* Use this for a source comprising single cell, also useful in other VBA code
Public Function SoftLink(ByVal sWorkbookName As String, ByVal sSheetName As String, ByVal sRangeName As String) As Excel.Range
    Dim wb As Excel.Workbook
    Set wb = OernColItem(Application.Workbooks, sWorkbookName)

    If Not wb Is Nothing Then

        Dim ws As Excel.Worksheet
        Set ws = OernColItem(wb.Worksheets, sSheetName)
        
        If Not ws Is Nothing Then
            Set SoftLink = OernWorksheetRange(ws, sRangeName)
        End If
    End If
End Function

Private Function OernWorksheetRange(ByRef ws As Excel.Worksheet, ByVal sRangeName As String) As Excel.Range
    On Error Resume Next
    Set OernWorksheetRange = ws.Range(sRangeName)
End Function

Private Function OernColItem(ByRef col As Object, ByVal idx As Variant) As Object
    On Error Resume Next
    Set OernColItem = col.Item(idx)
End Function

'**** TEST ****

Sub TestVBACallingSoftLink_LocalSheet()

    Const csSHEET1 As String = "Sheet1"

    Dim rng As Excel.Range
    Set rng = SoftLink(ThisWorkbook.Name, csSHEET1, "A1")
    
    Debug.Assert Not rng Is Nothing
    If Not rng Is Nothing Then
        Debug.Assert rng.Address = "$A$1"
        Debug.Assert rng.Worksheet.Name = csSHEET1
    End If
End Sub


Sub TestVBACallingSoftLink_ExternalWorkbook()
    Const csSHEET1 As String = "Sheet1"

    '*** test setup: create new workbook, add a name
    Dim wbNew As Excel.Workbook
    Set wbNew = Application.Workbooks.Add
    
    Const csNAME_FOO As String = "Foo"
    Dim ws As Excel.Worksheet
    Set ws = wbNew.Worksheets.Item(1)
    ws.Names.Add Name:=csNAME_FOO, RefersToR1C1:="=Sheet1!R4C8"
    ws.Range(csNAME_FOO).Value2 = 42
    '*** end of test setup:

    '*** now we can call our function to get a link to an external workbook
    Dim rng As Excel.Range
    Set rng = SoftLink(wbNew.Name, csSHEET1, csNAME_FOO)
    
    Debug.Assert Not rng Is Nothing
    If Not rng Is Nothing Then
        Debug.Assert rng.Address = "$H$4"
        Debug.Assert rng.Worksheet.Name = csSHEET1
        Stop
    End If
    wbNew.Close False
    Stop
End Sub

Javascript - Binary representation of VBA's Variant Array

I am delighted to give a world first in this post where I give JavaScript code to convert a JavaScript array into a byte array loadable into a VBA variant array. This gives an efficient binary serialization format for web services and other network calls where the end client is VBA and especially Excel worksheet cells.

Following on from the previous post where I document an undocumented file serialization format used by VBA with the FreeFile, Open For Binary and Put statements. I can now go on to give some JavaScript to convert two dimensional JavaScript arrays containing JavaScript variables therein to a byte array directly loadable by VBA into a variant array.

This now means a VBA client need not consume Xml or JSON when calling a web service. This is a big win because both Xml and JSON are string based and require parsing into data structures which is expensive. The Xml needs further code to interrogate the nodes with XPath etc. If the end destination for the data is the worksheet then the variant array can be directly pasted into cells (some code is give below).

To get VBA client code to do less work requires the server-side code to do more work. A JavaScript module, JavaScriptToVBAVariantArray.js, is given below which converts JavaScript arrays and variables into a byte array directly loadable by VBA (save for an few initial bytes conveying number of rows and columns).

As well the key JavaScript module, JavaScriptToVBAVariantArray.js, I also give some Node.js server-side JavaScript code to implement a web service that demonstrates the byte array being communicated to a VBA client.

JavaScriptToVBAVariantArray.js - module common to browser and server

So the following JavaScript module is usable in both the browser client and a Node.js server. It encapsulates all the logic to convert a two dimensional (block not nested) JavaScript array containing primitives of strings, Booleans, dates and numbers to a byte array loadable by VBA into a Variant array ready to be pasted onto a worksheet. Also included is logic to take a JavaScript Error object and convert this to an Excel worksheet error code so one can transmit #REF!, #N/A! and #NAME? errors.

The code is implemented as a prototyped class, it includes two test methods JavaScriptToVBAVariantArray.testPersistVar and JavaScriptToVBAVariantArray.testPersistGrid to demonstrate the code's usage. The remaining methods contain production logic that utilize ArrayBuffers and collaborating classes Float64Array and Uint8Array.

So the following code to be saved to its own separate file called JavaScriptToVBAVariantArray.js which then should be added to a Node.js project. I am using Microsoft Visual Studio for a development environment.

'use strict';

// module exporting for node.js and browsers with thanks to
// https://www.matteoagosti.com/blog/2013/02/24/writing-javascript-modules-for-both-browser-and-node/

(function () {
    var JavaScriptToVBAVariantArray = (function () {
        var JavaScriptToVBAVariantArray = function (options) {
            var pass; //...
        };


        JavaScriptToVBAVariantArray.prototype.testPersistVar = function testPersistVar() {
            try {
                var payload;
                //payload = "Hello World";
                //payload = false;
                //payload = 655.35;
                payload = new Date(1989, 9, 16, 12, 0, 0);
                var payloadEncoded = persistVar(payload);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.testPersistGrid = function testPersistGrid() {
            try {
                var rows = 2;
                var columns = 4;
                var arr = this.createGrid(rows, columns);
                arr[0][0] = "Hello World";
                arr[0][1] = true;
                arr[0][2] = false;
                arr[0][3] = null;

                arr[1][0] = 65535;
                arr[1][1] = 7.5;
                arr[1][2] = new Date(1989, 9, 16, 12, 0, 0);
                arr[1][3] = new Error(2042);

                var payloadEncoded = this.persistGrid(arr, rows, columns);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistGrid = function persistGrid(grid, rows, columns) {
            try {

                var payloadEncoded = new Uint8Array(4);
                payloadEncoded[0] = rows % 256; payloadEncoded[1] = Math.floor(rows / 256);
                payloadEncoded[2] = columns % 256; payloadEncoded[3] = Math.floor(columns / 256);
                var elementBytes;
                for (var colIdx = 0; colIdx < columns; colIdx++) {
                    for (var rowIdx = 0; rowIdx < rows; rowIdx++) {
                        elementBytes = this.persistVar(grid[rowIdx][colIdx]);
                        var arr = [payloadEncoded, elementBytes];

                        payloadEncoded = this.concatArrays(arr); // Browser
                    }
                }
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };


        JavaScriptToVBAVariantArray.prototype.concatArrays = function concatArrays(arrays) {
            // With thanks to https://javascript.info/arraybuffer-binary-arrays


            // sum of individual array lengths
            let totalLength = arrays.reduce((acc, value) => acc + value.length, 0);

            if (!arrays.length) return null;

            let result = new Uint8Array(totalLength);

            // for each array - copy it over result
            // next array is copied right after the previous one
            let length = 0;
            for (let array of arrays) {
                result.set(array, length);
                length += array.length;
            }

            return result;
        };

        JavaScriptToVBAVariantArray.prototype.createGrid = function createGrid(rows, columns) {
            try {
                return Array.from(Array(rows), () => new Array(columns));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistVar = function persistVar(v) {
            try {

                if (v === null) {
                    // return a Null
                    var nullVt = new Uint8Array(2);
                    nullVt[0] = 1;
                    return nullVt;

                } else if (v instanceof Error) {

                    return this.persistError(v);

                } else if (typeof v === 'undefined') {
                    return new Uint8Array(2); // return an Empty

                } else if (typeof v === "boolean") {
                    // variable is a boolean
                    return this.persistBool(v);
                } else if (typeof v.getMonth === "function") {
                    // variable is a Date
                    return this.persistDate(v);
                } else if (typeof v === "string") {
                    // variable is a boolean
                    return this.persistString(v);
                } else if (typeof v === "number") {
                    // variable is a number
                    return this.persistNumber(v);
                }

            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistError = function persistError(v) {
            try {
                var errorVt = new Uint8Array(6); // return a vtError
                errorVt[0] = 10; errorVt[4] = 10; errorVt[5] = 128;

                var errorNumber;
                try {
                    errorNumber = parseInt(v.message);
                }
                catch (err) {
                    errorNumber = 2000;
                    console.log(err.message);
                }
                errorVt[2] = errorNumber % 256; errorVt[3] = Math.floor(errorNumber / 256);

                return errorVt;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistNumber = function persistNumber(v) {
            try {
                var bytes;
                if (Number.isInteger(v)) {
                    bytes = new Uint8Array(6);
                    bytes[0] = 3; bytes[1] = 0;  // VarType 5 = Long
                    bytes[2] = v % 256; v = Math.floor(v / 256);
                    bytes[3] = v % 256; v = Math.floor(v / 256);
                    bytes[4] = v % 256; v = Math.floor(v / 256);
                    bytes[5] = v % 256;

                } else {
                    bytes = this.persistDouble(v, 5);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDate = function persistDate(v) {
            try {
                // convert JavaScript 1970 base to VBA 1900 base
                // https://stackoverflow.com/questions/46200980/excel-convert-javascript-unix-timestamp-to-date/54153878#answer-54153878
                var xlDate = v / (1000 * 60 * 60 * 24) + 25569;
                return this.persistDouble(xlDate, 7);
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDouble = function persistDouble(v, vt) {
            try {
                var bytes;
                bytes = new Uint8Array(10);
                bytes[0] = vt; bytes[1] = 0;  // VarType 5 = Double or 7 = Date
                var doubleAsBytes = this.doubleToByteArray(v);
                for (var idx = 0; idx < 8; idx++) {
                    bytes[2 + idx] = doubleAsBytes[idx];
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.doubleToByteArray = function doubleToByteArray(number) {
            try {
                // https://stackoverflow.com/questions/25942516/double-to-byte-array-conversion-in-javascript/25943197#answer-39515587
                var buffer = new ArrayBuffer(8);         // JS numbers are 8 bytes long, or 64 bits
                var longNum = new Float64Array(buffer);  // so equivalent to Float64

                longNum[0] = number;

                return Array.from(new Int8Array(buffer));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistString = function persistString(v) {
            try {
                var strlen = v.length;
                var bytes = new Uint8Array(strlen + 4);
                bytes[0] = 8; bytes[1] = 0;  // VarType 8 = String
                bytes[2] = strlen % 256; bytes[3] = Math.floor(strlen / 256);
                for (var idx = 0; idx < strlen; idx++) {
                    bytes[idx + 4] = v.charCodeAt(idx);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistBool = function persistBool(v) {
            try {
                var bytes = new Uint8Array(4);
                bytes[0] = 11; bytes[1] = 0;   // VarType 11 = Boolean
                if (v === true) {
                    bytes[2] = 255; bytes[3] = 255;
                } else {
                    bytes[2] = 0; bytes[3] = 0;
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        return JavaScriptToVBAVariantArray;
    })();

    if (typeof module !== 'undefined' && typeof module.exports !== 'undefined')
        module.exports = JavaScriptToVBAVariantArray;
    else
        window.JavaScriptToVBAVariantArray = JavaScriptToVBAVariantArray;
})();

Node.js server code

The following code should is for running in Node.js. Start with a new Blank Node.js Web Application project in Microsoft Visual Studio, add the JavaScriptToVBAVariantArray.js module listed above. In the server.js file replace the code with the listing below. Running the project should spawn a new browser and then print something like the following, i.e. a mix of printable and non-printable characters; this is a browser attempting to display the generated byte array.

    Hello World ÿÿ ÿÿ  @  «ªªª® à@  ú  €

'use strict';

{
    try {
        var JavaScriptToVBAVariantArray = require('./JavaScriptToVBAVariantArray');
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
    }
    catch (err) {
        console.log('Could not find JavaScriptToVBAVariantArray.js module:' + err.message);
    }
}

require('http').createServer(function (req, res) {
    try {
        var q = require('url').parse(req.url, true);
        if (q.pathname === '/') {
            /* it's the request for our serialized Variant array */
            res.writeHead(200, { 'Content-Type': 'text/html' });

            // https://stackoverflow.com/questions/8609289/convert-a-binary-nodejs-buffer-to-javascript-arraybuffer
            var buffer = Buffer.from(new Uint8Array(payloadEncoded));
            res.end(buffer);
        }
        else {
            var filename = "." + q.pathname;
            var fs = require('fs');
            fs.readFile(filename, function (err, data) {
                if (err) {
                    res.writeHead(404, { 'Content-Type': 'text/html' });
                    return res.end("404 Not Found");
                }
                res.writeHead(200, { 'Content-Type': 'text/html' });
                res.write(data);
                return res.end();
            });
        }
    }
    catch (err) {
        console.log(err.message);
    }
}).listen(process.env.PORT || 1337);

HTMLPage.html (optional)

I intend the end client to be VBA as we are demonstrating how to serialize to a byte array loadable by VBA. Nevertheless, I include an HTML page to prove the JavaScript works in the browser. Also, if one follows the instructions on the web page and one opens the Dev Tools and the Console then one can see the byte array is a more readily viewable form (or at least more viewable that the non-printable characters above). Once this is added to your Node.js project then in a browser you can type the url http://localhost:1337/HtmlPage.html to access the page.

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <meta charset="utf-8" />
    <title></title>
</head>
<body>
    <p>
        <span style="font-family:Courier New, Courier, monospace">
            Look in the console!
            Do this by right-click menu and then Inspect to get the DevTools window
            then click on the Console tab
        </span>
    </p>
    <script src="https://raw.githubusercontent.com/arextar/browser-buffer/master/browser-buffer.min.js"></script>
    <script src="JavaScriptToVBAVariantArray.js"></script>
    <script>
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
        console.log(payloadEncoded);
    </script>
</body>
</html>

Client VBA Code

Finally, we get to the VBA client code. Paste this into a standard module, you will need some code from the previous post. You will also need a Tools->Reference to Microsoft WinHTTP Services, version 5.1 to make the HTTP call.

So the listing below will call into the Javascript web service given above, it takes the HTTP response and then reads the rows and columns from the first four bytes, the remaining bytes it will write to a temporary file (this could be speeded with the use of a RAM disk). The temporary file is then read directly into a variant array new dimensioned with the correct rows and columns.

At this point any VBA code can work with this variant array like it was any other as the byte array has been converted to a VBA native data structure! The code below goes on to paste the variant array to a block of cells on a worksheet (please save your work as this overwrites the cells).

In the pasted cells (screenshot given) we can see a string, two booleans, a deliberately empty cell, an integer, a decimal number, a date, and a #N/A worksheet error code. This demonstrates the full range of variable types that can be transmitted via the byte array.

Sub TestByWinHTTP()
    Dim WinHttp As WinHttp.WinHttpRequest '* Tools->References->Microsoft WinHTTP Services, version 5.1
    Set WinHttp = New WinHttp.WinHttpRequest
    WinHttp.Open "GET", "http://localhost:1337/", False
    WinHttp.send
    
    If WinHttp.Status = 200 Then
        If IsEmpty(WinHttp.responseBody) Then Err.Raise vbObjectError, , "No bytes returned!"
        If UBound(WinHttp.responseBody) = 0 Then Err.Raise vbObjectError, , "No bytes returned!"
        
        '**** SAVE ****
        Dim lSaveFileNum As Long
        Dim sFullFilename As String
        sFullFilename = OpenCleanFileForBinary("JavascriptToVBABin.bin", lSaveFileNum)
        
        
        Dim lRows As Long, lColumns As Long
        lRows = WinHttp.responseBody(0) + WinHttp.responseBody(1) * 256
        lColumns = WinHttp.responseBody(2) + WinHttp.responseBody(3) * 256
        
        Dim lByteLoop As Long
        For lByteLoop = 4 To UBound(WinHttp.responseBody)
            Put lSaveFileNum, , CByte(WinHttp.responseBody(lByteLoop))
        Next lByteLoop
        Close lSaveFileNum
        
        '**** LOAD ****
        
        ReDim vGrid(0 To lRows - 1, 0 To lColumns - 1) As Variant
        Dim lLoadFileNum As Long
        lLoadFileNum = OpenFileForBinary(sFullFilename)
        Get lLoadFileNum, , vGrid
        Close lLoadFileNum
        
        '**** WRITE TO WORKSHEET CELLS ****
        
        Stop '* next line will overwrite cells!! please save your work!!
        Sheet1.Range("a11").Resize(lRows, lColumns).Value = vGrid
        Stop '* Observe the cells on the worksheet
    End If
End Sub

Final Thoughts

It is a shame that the serialization format does not natively include the dimensions of the array block/grid as I could shave even more lines of code on the VBA side. It is also a shame we have to write the file to disk instead of being able to load directly into memory; there is the option of using a RAM disk to speed the file operation. In the meantime I feel I can write JavaScript Chrome extensions that could now transmit blocks of cells to an Excel client in VBA's native serialization format. Cool!

VBA - Export a worksheet to CSV

I just had a need to export a worksheet to CSV (comma separated value) file and was surprised that one must create a new workbook and copy over the sheet. I would have thought Microsoft would have written a nice 'ExportToCSV' method by now. Anyway the code samples of StackOVerflow did not satisfy me so I wrote my own, here is my code.

Option Explicit

Sub TestExportSheetToCsv()
    Dim sDir As String
    sDir = "C:\Users\Simon\source\repos\PythonBaseHttpPlusQueryParams\PythonBaseHttpPlusQueryParams\"
    
    ExportSheetToCsv ThisWorkbook, sDir, "DomainToBrokerMap"
    ExportSheetToCsv ThisWorkbook, sDir, "BrokerQuerySelectors"
    ExportSheetToCsv ThisWorkbook, sDir, "MarketDataItems"
    ExportSheetToCsv ThisWorkbook, sDir, "BrokerDrilldown"
    
End Sub

Sub ExportSheetToCsv(ByVal wbSrc As Excel.Workbook, ByVal sDir As String, ByVal sSheetName As String)
    Application.ScreenUpdating = False
    Dim wbExport As Excel.Workbook
    Set wbExport = Workbooks.Add

    Dim wsExport As Excel.Worksheet
    Set wsExport = ThisWorkbook.Worksheets.Item(sSheetName)
    wsExport.Copy , wbExport.Worksheets.Item(1)

    Application.DisplayAlerts = False
    wbExport.Worksheets.Item(1).Delete
    Application.DisplayAlerts = True
    
    Dim sExportFileName As String
    sExportFileName = sDir & sSheetName & ".csv"
    
    If Len(Dir(sExportFileName)) > 0 Then
        Kill sExportFileName
        Debug.Assert Len(Dir(sExportFileName)) = 0
    End If
    
    wbExport.SaveAs sExportFileName, FileFormat:=xlCSV, CreateBackup:=False
    
    Debug.Print "Exported " & sExportFileName
    
    wbExport.Close False
    Application.ScreenUpdating = True
End Sub

VBA - Sheet Diagram to SVG

The VBA code below will inspect the text, hyperlinks and borders of an Excel range on a worksheet and convert to SVG (Scalable Vector Graphics) for use in an HTML context.

I wanted more diagrams on my blog and I knew I wanted to use SVG but I did not want to wrestle with an HTML artwork package such as InkScape. I felt the Excel worksheet grid is a perfectly good way to layout a diagram so Excel is my authoring tool. You can see an example of a diagram converted to SVG, below is a screenshot of the original Excel worksheet. Even further below is the source code.

Note: to get working in a blog I have had to remove the namespaces. It is nice to see hyperlinks working albeit I used javascript when then the anchor element did not render.

Option Explicit

'* Tools->References
'* Microsoft Scripting Runtime
'* Microsoft Xml v6.0
'*

Sub Test()

    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    
    Dim sSVGPath As String
    sSVGPath = "N:\InterfaceDiagram6.svg"
    
    Dim txtOut As Scripting.TextStream
    Set txtOut = fso.CreateTextFile(sSVGPath)
    txtOut.WriteLine "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?>"
    txtOut.WriteLine "<svg:svg id='Simon1' xmlns:svg=""http://www.w3.org/2000/svg"" xmlns:xlink='http://www.w3.org/1999/xlink'>"
    txtOut.WriteLine "<svg:g  id='Simon2' transform='scale(2)' >"

    Dim wb As Excel.Workbook
    Set wb = ThisWorkbook 'Set wb = Workbooks(1)
    
    Dim sht1 As Excel.Worksheet
    Set sht1 = wb.Worksheets.Item("Sheet1")

    Dim vRegions As Variant
    vRegions = Array(Array(sht1.Range("b4:c13"), "Group1"), _
                    Array(sht1.Range("d2:f20"), "Group2"), _
                    Array(sht1.Range("g2:h20"), "Group3"))
                    
                    
    Test2 txtOut, vRegions


    txtOut.WriteLine "</svg:g >"
    txtOut.WriteLine "</svg:svg>"

    txtOut.Close
    Set txtOut = Nothing

    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    Debug.Assert dom.Load(sSVGPath)

    Debug.Assert dom.parseError = 0

End Sub


Sub Test2(txtOut, ByVal vRegions As Variant)

    Dim vRegionsLoop
    For Each vRegionsLoop In vRegions
                
        Dim rng As Excel.Range
        Set rng = vRegionsLoop(0)
        
        Dim sRegionId
        sRegionId = vRegionsLoop(1)
        
        txtOut.WriteLine "<svg:g id='" & sRegionId & "' >"
        
        Dim rngLoop As Excel.Range
        For Each rngLoop In rng.Cells
            txtOut.Write BordersToSvg(rngLoop)
            txtOut.Write TextToSvg(rngLoop)
        Next
    
        txtOut.WriteLine "</svg:g >"
    Next

End Sub


Function TextToSvg(ByVal rng As Excel.Range) As String
    Debug.Assert rng.Rows.Count = 1
    Debug.Assert rng.Columns.Count = 1

    Dim sText As String
    sText = rng.Value2

    If Len(sText) > 0 Then
    
        Dim fill As String
        fill = "fill:#000000"
    
        If rng.Hyperlinks.Count > 0 Then
            Dim lnk As Excel.Hyperlink
            Set lnk = rng.Hyperlinks.Item(1)
            
            Dim javascript As String
            javascript = " ondblclick=""window.open(&quot;" & lnk.Address & "&quot;)"" " & vbNewLine
            javascript = javascript & " onmouseover=""this.style['fill']='#ffc000';console.log(this.style['fill']);"" " & vbNewLine
            javascript = javascript & " onmouseout=""this.style['fill']='#2288bb';console.log(this.style['fill']);"" " & vbNewLine
            fill = "fill:#2288bb"
        End If
    
        Dim fnt As Excel.Font
        Set fnt = rng.Font
        
        Dim fntPx As Long
        fntPx = fnt.Size * 1 ' 4# / 3#
        
        
        Dim fntStyle As String
        fntStyle = "font-style:normal;font-weight:normal;font-size:" & fntPx & "px;line-height:1.25;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;" & fill & ";fill-opacity:1;stroke:none"
    
        Dim x
        x = rng.Left
        
        Dim y
        y = rng.Top + rng.Height
    
        Dim sId As String
        sId = VBA.Replace(rng.Address, "$", "")

        Dim s As String
        s = vbNewLine
        s = s & "<svg:text id='" & sId & "txt' x='" & x & "' y='" & y & "' style='" & fntStyle & "' " & javascript & " >" & vbNewLine
        s = s & "<svg:tspan id='" & sId & "tspan'  x='" & x + 1.25 & "' y='" & y - 2 & "' >" & sText & "</svg:tspan>" & vbNewLine
        s = s & "</svg:text>" & vbNewLine
    End If
    TextToSvg = s

End Function

Function BordersToSvg(ByVal rng As Excel.Range) As String
    Debug.Assert rng.Rows.Count = 1
    Debug.Assert rng.Columns.Count = 1
    
    Dim dicKeyedByStyle As Scripting.Dictionary
    Set dicKeyedByStyle = New Scripting.Dictionary
    
    Dim vEdges As Variant
    vEdges = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    
    Dim vEdges2 As Variant
    vEdges2 = Array("xlEdgeLeft", "xlEdgeTop", "xlEdgeBottom", "xlEdgeRight")
    
    Dim lEdgeLoop As Long
    For lEdgeLoop = 7 To 10
        
        Dim brd As Excel.Border
        Set brd = rng.Borders.Item(lEdgeLoop)
        
        If Not IsNull(brd.TintAndShade) Then
            
            Dim sLine As String
            sLine = ""
            
            If lEdgeLoop = xlEdgeBottom Then
                sLine = "M " & rng.Left & "," & rng.Top + rng.Height & " L " & rng.Left + rng.Width & "," & rng.Top + rng.Height
            ElseIf lEdgeLoop = xlEdgeTop Then
                sLine = "M " & rng.Left & "," & rng.Top & " L " & rng.Left + rng.Width & "," & rng.Top
            ElseIf lEdgeLoop = xlEdgeLeft Then
                sLine = "M " & rng.Left & "," & rng.Top & " L " & rng.Left & "," & rng.Top + rng.Height
            ElseIf lEdgeLoop = xlEdgeRight Then
                sLine = "M " & rng.Left + rng.Width & "," & rng.Top & " L " & rng.Left + rng.Width & "," & rng.Top + rng.Height
            End If
            
            Dim sStyleKey As String
            sStyleKey = "stroke-width:1;stroke:#" & Right$("000000" & Hex$(brd.Color), 6) & ";" & VBA.IIf(brd.LineStyle <> 1, "stroke-miterlimit:4;stroke-dasharray:2,2;stroke-dashoffset:0", "")
            
            If dicKeyedByStyle.Exists(sStyleKey) Then
                dicKeyedByStyle(sStyleKey) = dicKeyedByStyle(sStyleKey) & " " & sLine
            Else
                dicKeyedByStyle(sStyleKey) = sLine
            End If
        End If
    Next
    
    Dim lStyleLoop As Long
    For lStyleLoop = 0 To dicKeyedByStyle.Count - 1
    
        Dim vUniqueStyle As Variant
        vUniqueStyle = dicKeyedByStyle.Keys()(lStyleLoop)
        
        Dim sId As String
        sId = "id=""" & VBA.Replace(rng.Address, "$", "") & "_" & lStyleLoop & """"
        
        Dim sStyle As String
        sStyle = " style=""" & vUniqueStyle & """ "
        
        Dim sSvgHtml As String
        sSvgHtml = "<svg:path " & sId & sStyle & " d=""" & dicKeyedByStyle(vUniqueStyle) & """/>"
    
        BordersToSvg = BordersToSvg & sSvgHtml & vbNewLine
    Next

End Function

ATL C++ Automation Add-in gives another way to call C++ from worksheet

I discovered this by accident. I was attempting to get a C# Automation Add-in working (conceptually a very easy task but I keep hitting a barrier) and I got frustrated so I dropped down into C++ to try to get a feel for what is going on. I was surprised to find a simple ATL C++ COM component callable from the worksheet simply by adding the registry key "Programmable" to the registry entries for the COM class.

Automation Add-ins

So there have been various Office addins over the years. Microsoft keeps moving the goalposts as to what it wants developers to build to augment Excel's functionality. As I write, the latest Microsoft is pushing is JavaScript based. But years ago, Automation Add-Ins and COM Add-Ins were trendy.

An Automation Add-in allows developers to create COM components and make them callable from an Excel worksheet function with the addition of the registry key "Programmable" to the registry entries for the COM class. I must confess to associating this primarily with the .NET languages, C# and VB.Net. C++ programmers have always has the C++ Excel Software Development Kit, so I thought Automation Add-ins were pretty much was ignored by C++ developers. Certainly amongst my C++ colleagues they were overlooked.

So it was to my surprise that an ATL project is callable from the worksheet. I may very well post more examples on this. Below you will some simple code but also a video of a part of my investigations.

Incidentally, a COM Add-in goes one better than an Automation Add-in in that the developer can acquire the Application object and thus can script against the Excel COM object library. But that is not discussed in this blog post.

Simple ATL Object

So I added a single Simple ATL Object to a brand new ATL project. And then I declared the interface to have one single method called DivideBy2 for experimentation. The IDL is given here

ATLProject5.idl

1. // ATLProject5.idl : IDL source for ATLProject5
2. // Brought to you by the Excel Development Blog https://exceldevelopmentplatform.blogspot.com/2018/11/
3.  
4. // This file will be processed by the MIDL tool to
5. // produce the type library (ATLProject5.tlb) and marshalling code.
6.  
7. import "oaidl.idl";
8. import "ocidl.idl";
9. import "shobjidl.idl";
10.  
11. [
12.     uuid(B4644DBF-2A3D-4CE7-8A01-B83AAFEBA1F2),
13.     version(1.0)
14. ]
15. library ATLProject5Lib
16. {
17.     importlib("stdole2.tlb");
18.  
19.     // Forward declare all types defined in this typelib
20.     interface IATLSimpleObject;
21.  
22.     [
23.         uuid(1a4a53f8-5323-418f-8975-d05f47c1dceb),
24.         version(1.0),
25.     ]
26.     interface IATLSimpleObject : IDispatch
27.     {
28.         HRESULT DivideBy2([in]double dIn, [out,retval] double* dOut);
29.     };
30.  
31.     [
32.         uuid(1ABD0403-A8D5-40F6-8D9E-E0343999CD65),
33.         version(1.0)
34.     ]
35.     coclass ATLSimpleObject
36.     {
37.         [default] interface IATLSimpleObject;
38.     };
39. };

ATLSimpleObject.h

The edited class declaration is given here, in the video below I put a breakpoint in the interface map to see what gets interfaces get queried for.

1. // ATLSimpleObject.h : Declaration of the CATLSimpleObject
2. // Brought to you by the Excel Development Blog https://exceldevelopmentplatform.blogspot.com/2018/11/
3.  
4.  
5. using namespace ATL;
6.  
7.  
8. // CATLSimpleObject
9.  
10. class ATL_NO_VTABLE CATLSimpleObject :
11.     public CComObjectRootEx<CComSingleThreadModel>,
12.     public CComCoClass<CATLSimpleObject, &CLSID_ATLSimpleObject>,
13.     public IDispatchImpl<IATLSimpleObject, &IID_IATLSimpleObject, &LIBID_ATLProject5Lib, /*wMajor =*/ 1, /*wMinor =*/ 0>
14. {
15. public:
16.     CATLSimpleObject()
17.     {
18.     }
19.  
20. BEGIN_COM_MAP(CATLSimpleObject)
21.     COM_INTERFACE_ENTRY(IATLSimpleObject)
22.     COM_INTERFACE_ENTRY(IDispatch)
23. END_COM_MAP()
24.  
25.  
26.     DECLARE_PROTECT_FINAL_CONSTRUCT()
27.  
28.     HRESULT FinalConstruct()
29.     {
30.         return S_OK;
31.     }
32.  
33.     void FinalRelease()
34.     {
35.     }
36.  
37. public:
38.  
39.     STDMETHOD(DivideBy2)(double dIn, double* dOut);
40.  
41. };
42.  
43. OBJECT_ENTRY_AUTO(__uuidof(ATLSimpleObject), CATLSimpleObject)

ATLSimpleObject.cpp

The class implementation is trivial

1. // ATLSimpleObject.cpp : Implementation of CATLSimpleObject
2. // Brought to you by the Excel Development Blog https://exceldevelopmentplatform.blogspot.com/2018/11/
3.  
4. #include "stdafx.h"
5. #include "ATLSimpleObject.h"
6.  
7. // CATLSimpleObject
8.  
9. STDMETHODIMP CATLSimpleObject::DivideBy2(double dIn, double* dOut)
10. {
11.     *dOut = dIn / 2;
12.     return S_OK;
13. }

Video of QueryInterface Investigation

So I discovered ATL being callable from the worksheet as I was investigating what interfaces neeed to be implemeneted. I made a video of my investigations where I set a breakpoint here...

Video Links

So there were some links in the video regarding the Sharepoint interface and the PowerBasic forum and these are given here

• ISharePoint - Custom Document Parsers in Share Point
• Excel com automation addin - PowerBASIC Peer Support Community

C# - Excel Moniker Class to pack cell address to single string

In one single string, I need to encode a path to a block of Excel cells including the correct Excel.exe process (in case there is more than one Excel). I need this for an OLE DB Provider Custom Implementation where one only gets a single string to pack in all the details. As the OLE DB provider is written in C# then I implement an Excel Moniker Class also in C#.

There is an established COM moniker form for an Excel cell address qualified by worksheet, workbook and file location. I use this as the base of my moniker. I then bolt on the Hwnd of the specific Excel session as a prefix.

COM Monikers To Specify Excel Ranges

I do not want to replicate the COM specification here but there is such a thing as a COM moniker. A COM moniker is a bit like a URL (web address) or a file path. COM monikers can be composed of subtype COM moniker such as file moniker. The segments of such composite monikers by convention are frequently separated by the bang (exclamation mark) '!' . It is possible for a composite moniker to be parsed segment by segment passing control of each segment parsing to a separate component. This is emblematic of COM's component design.

An example of a composite moniker is an Excel cell located in another workbook. But first, let's build it up piece by piece. N.B. all the following examples show an equals sign as if in a formula. If on the same sheet a cell address requires no qualification, e.g. =$A$1. A cell address on another sheet requires the sheet name as a qualifier e.g. =Sheet2!$A$1 (note the bang '!' as separator) . A problem arises if the other sheet has a space in its name as this then requires surrounding quotes, e.g. ='Sheet 3'!$E$8 . A cell address in another workbook requires further qualification with the workbook enclosed in square brackets ...

=[TestClient.xlsm]Sheet5!$C$6

If there is a space in the workbook name then this (just like a worksheet name) has to be surrounded in single quotes.

='[Book With Space in Name.xlsx]Sheet1'!$D$6

Moreover, sometimes a workbook needs to be qualified by its full path so a full moniker could look like ...

=[C:\Temp\TestClient.xlsm]Sheet5!$C$6

Then there is the issue of using a named range instead of a cell address. Furthermore, a named range can be either local or global which gives us two extra forms...

=[TestClient.xlsm]Sheet5!LocalName
=[TestClient.xlsm]!GlobalName

So lots of logic to program into a moniker class.

Additionally specifying Excel session with Hwnd

As highlighted in previous post, it is possible to identify and reach a specify Excel session running by means of its Hwnd by using the IAccessible interface. I use this in the code to identify the correct and specific Excel.exe session in case there are two. I bolt on the Hwnd as a prefix separated by a tick ` .

XlMoniker Class Source Code

So the following is C# code to be housed in an assembly that is registered for interop (Visual Studio will need admin rights to register).

Public XlMoniker Class and IXlMoniker

There is more than one class in the code below and so it is required to distinguish in this commentary. To expose functionality to VBA we need to ship a COM interface, that is IXlMoniker and also we need to shiop a COM class, XlMoniker that implements the interface IXlMoniker. There are three methods, GetExcelByHwnd was covered in prior post. ExcelRangeToMoniker takes a range and returns a moniker string. GetExcelRangeFromMoniker takes a moniker string and returns a range.

Internal XlMonikerParser Class

I have separated out the parsing and string handling in a separate class XlMonikerParser. This has no COM interface and so is not exposed to VBA. The code in this class lends itself to unit testing and the Unit test code is given below.

using System;
using System.Runtime.InteropServices;

namespace XlMoniker
{
    [ComVisible(true)]
    public interface IXlMoniker
    {
        bool GetExcelByHwnd(int lhwndApp, ref object app);
        bool GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal);
        string ExcelRangeToMoniker(object rng);
    }

    public class XlMonikerParser
    {
        public bool ParseMoniker(string sFullMoniker, out string sHwnd, out string sWorkbook,
                    out string sWorksheet, out string sCellAddress)
        {
            bool retval = false; sHwnd = ""; sWorkbook = ""; sWorksheet = ""; sCellAddress = "";

            if (this.ParseLeadingHwnd(sFullMoniker, out sHwnd, out string sFileAndCellAddressMoniker))
            {
                if (this.ParseWorkbookAndSheetFromCellAddress(sFileAndCellAddressMoniker, out string sWorkbookAndSheet, out sCellAddress))
                {
                    if (this.ParseWorkbookFromSheet(sWorkbookAndSheet, out sWorkbook, out sWorksheet))
                    {
                        return true;
                    }
                }
            }

            return retval;
        }

        public bool ParseWorkbookFromSheet(string sWorkbookAndSheet, out string sWorkbook,
                    out string sWorksheet)
        {
            bool retval = false; sWorkbook = ""; sWorksheet = "";
            // if workbook or sheet name contain a space then single quotes wrap them isolating them from the cell address
            // '[Book With Space in Name.xlsx]Sheet1'
            // [TestClient.xlsm]Sheet1


            string[] splitOnSingleQuotes = sWorkbookAndSheet.Split(''');
            string sWithoutSingleQuotes = splitOnSingleQuotes.Length == 3 ? splitOnSingleQuotes[1] : sWorkbookAndSheet;

            char[] squareBrackets = new char[] { '[', ']' };
            string[] splitOnSquareBrackets = sWithoutSingleQuotes.Split(squareBrackets);
            if (splitOnSquareBrackets.Length == 3)
            {
                sWorkbook = splitOnSquareBrackets[1];
                sWorksheet = splitOnSquareBrackets[2];
                return true;
            }
            else if (splitOnSquareBrackets.Length == 1)
            {
                sWorkbook = splitOnSquareBrackets[0];
                sWorksheet = ""; // possibly a global name
                return true;
            }

            return retval;
        }

        public bool ParseWorkbookAndSheetFromCellAddress(string sFileAndCellAddressMoniker, out string sWorkbookAndSheet,
                    out string sCellAddress)
        {
            bool retval = false; sWorkbookAndSheet = ""; sCellAddress = "";

            string[] splitOnBang = sFileAndCellAddressMoniker.Split('!');
            // expecting only one bang to split the workbook and sheet name from the cell address , so two elements
            if (splitOnBang.Length == 2)
            {
                sWorkbookAndSheet = splitOnBang[0];
                sCellAddress = splitOnBang[1];
                return true;
            }

            return retval;
        }

        public bool ParseLeadingHwnd(string sFullMoniker, out string sHwnd, out string sFileAndCellAddressMoniker)
        {
            bool retval = false;
            sHwnd = "";
            sFileAndCellAddressMoniker = "";

            string[] splitOnTick = sFullMoniker.Split('`');
            // expecting only one tick to split the Hwnd from the rest of the moniker, so two elements
            if (splitOnTick.Length == 2)
            {
                sHwnd = splitOnTick[0];
                sFileAndCellAddressMoniker = splitOnTick[1];
                return true;
            }

            return retval;
        }
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IXlMoniker))]
    [ComVisible(true)]
    public class XlMoniker : IXlMoniker
    {
        const char separator = '`';

        [DllImport("user32.dll", SetLastError = true)]
        static extern IntPtr FindWindowEx(IntPtr hwndParent, IntPtr hwndChildAfter, string lpszClass, string lpszWindow);


        [DllImport("oleacc.dll", SetLastError = true)]
        internal static extern int AccessibleObjectFromWindow(IntPtr hwnd, uint id, ref Guid iid,
                                                    [In, Out, MarshalAs(UnmanagedType.IUnknown)] ref object ppvObject);

        bool IXlMoniker.GetExcelByHwnd(int lhwndApp2, ref object appRetVal)
        {
            bool bRetVal = false;

            IntPtr lhwndApp = (IntPtr)lhwndApp2;

            IntPtr lHwndDesk = FindWindowEx(lhwndApp, IntPtr.Zero, "XLDESK", "");
            if (lHwndDesk != IntPtr.Zero)
            {

                IntPtr lHwndExcel7 = FindWindowEx(lHwndDesk, IntPtr.Zero, "EXCEL7", null);
                if (lHwndExcel7 != IntPtr.Zero)
                {
                    Guid IID_IDispatch = new Guid("{00020400-0000-0000-C000-000000000046}");
                    const uint OBJID_NATIVEOM = 0xFFFFFFF0;
                    object app = null;
                    if (AccessibleObjectFromWindow(lHwndExcel7, OBJID_NATIVEOM, ref IID_IDispatch, ref app) == 0)
                    {
                        dynamic appWindow = app;
                        appRetVal = appWindow.Application;
                        return true;
                    }
                }
            }
            return bRetVal;
        }


        bool IXlMoniker.GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal)
        {
            bool retval = false;

            XlMonikerParser parser = new XlMonikerParser();
            retval = parser.ParseMoniker(sMoniker, out string sHwnd, out string sWorkbook,
                        out string sWorksheet, out string sCellAddress);
            if (retval)
            {
                if (int.TryParse(sHwnd, out int lHwnd))
                {
                    dynamic xlApp = null;
                    if (((IXlMoniker)this).GetExcelByHwnd(lHwnd, ref xlApp))
                    {

                        if (FindWorkbookByFullName(sWorkbook, xlApp, out dynamic wbFound))
                        {
                            if (sWorksheet.Length == 0)
                            {
                                // perhaps a global name
                                if (TryGetName(sCellAddress, wbFound, out dynamic nameFound))
                                {
                                    rngRetVal = nameFound.RefersToRange;
                                    return true;
                                }
                            }
                            else
                            {
                                if (FindWorksheetByName(sWorksheet, wbFound, out dynamic wsFound))
                                {
                                    // perhaps a local name
                                    if (TryGetName(sCellAddress, wsFound, out dynamic nameFound))
                                    {
                                        rngRetVal = nameFound.RefersToRange;
                                        return true;
                                    }
                                    else
                                    {
                                        // here it can only be a cell address
                                        if (TryGetRange(wsFound, sCellAddress, out dynamic range))
                                        {
                                            rngRetVal = range;
                                            return true;
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }

            return retval;
        }

        bool FindWorkbookByFullName(string sWorkbookFullName, dynamic xlApp, out dynamic wbFound)
        {
            bool retVal = false;
            wbFound = null;
            if (xlApp != null)
            {
                foreach (var wb in xlApp.workbooks)
                {
                    if (wb.FullName == sWorkbookFullName)
                    {
                        wbFound = wb;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool FindWorksheetByName(string sWorksheetName, dynamic wb, out dynamic wsFound)
        {
            bool retVal = false;
            wsFound = null;
            if (wb != null)
            {
                foreach (var ws in wb.worksheets)
                {
                    if (ws.Name == sWorksheetName)
                    {
                        wsFound = ws;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool TryGetName(string sNameName, dynamic wsOrWb, out dynamic nameFound)
        {   // this should work for both the Names collection off the workbook (i.e. global) and off each worksheet (i.e. Local)
            bool retVal = false;
            nameFound = null;
            if (wsOrWb != null)
            {
                try
                {
                    nameFound = wsOrWb.Names.Item(sNameName);
                    retVal = true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool TryGetRange(dynamic ws, string sCellAddress, out dynamic range)
        {
            bool retVal = false;
            range = null;
            if (ws != null)
            {
                try
                {
                    range = ws.Range(sCellAddress);
                    return true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool IsRangeNamed(dynamic rng, out dynamic nameFound)
        {
            bool retVal = false;
            nameFound = null;

            try
            {
                nameFound = rng.Name;
                return true;
            }
            catch
            { }

            return retVal;
        }

        string IXlMoniker.ExcelRangeToMoniker(dynamic rng)
        {
            string retval = "";
            if (rng != null)
            {
                dynamic ws = null; dynamic wb = null; dynamic xlApp = null; int hwnd;
                try
                {
                    ws = rng.Worksheet;
                    wb = ws.Parent;
                    xlApp = wb.Application;
                    hwnd = xlApp.hwnd();
                }
                catch
                {
                    throw new Exception("Error navigating from Range->Worksheet->Parent(Workbook)->Application->Hwnd!");
                }

                try
                {
                    string hwndPrefix = hwnd.ToString() + separator.ToString();
                    string sWorkbookFullName = wb.FullName;
                    string sWorksheetName = ws.Name;

                    if (IsRangeNamed(rng, out dynamic nameFound))
                    {   // range is named, but global or local, presence of ! indicates local
                        string sName = nameFound.Name;
                        bool quoteWorkbook = sWorkbookFullName.Contains(" ");
                        bool quoteWorksheet = sWorksheetName.Contains(" ");

                        if (sName.Contains("!"))
                        {   // it's local 
                            // use single quotes if there is a space in workbook name or sheetname
                            if (quoteWorkbook || quoteWorksheet)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]" + sName;
                            }
                        }
                        else
                        {   // it's global
                            // use single quotes if there is a space in workbook name
                            if (quoteWorkbook)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]'!" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]!" + sName;
                            }
                        }
                    }
                    else
                    {   // range is not named just a cell address, so expect a worksheetname
                        if (sWorkbookFullName.Contains(" ") || sWorksheetName.Contains(" "))
                        {
                            return hwndPrefix + "'[" + sWorkbookFullName + "]" + sWorksheetName + "'!" + rng.Address;
                        }
                        else
                        {
                            return hwndPrefix + "[" + sWorkbookFullName + "]" + sWorksheetName + "!" + rng.Address;
                        }
                    }
                }
                catch
                {
                    throw new Exception("Error building moniker string!");
                }
            }
            return retval;
        }
    }

}

VBA Client Code

So this is VBA code to test our class. Though the real test is when I blog an OLEDB Provider that accepts a cell moniker to generate a table, that is upcoming, watch this blog!

Option Explicit
Option Private Module

Private moXlMoniker As SimpleOLEDBProvider1.XlMoniker

Public Function GetXlMoniker() As SimpleOLEDBProvider1.XlMoniker
    If moXlMoniker Is Nothing Then
        Set moXlMoniker = New SimpleOLEDBProvider1.XlMoniker
    End If
    Set GetXlMoniker = moXlMoniker
End Function

Public Sub ResetXlMoniker()
    Set moXlMoniker = Nothing
End Sub

Private Sub Test_XlMoniker_GetExcelRange2()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim sht1 As Excel.Worksheet
    Set sht1 = ThisWorkbook.Worksheets("Sheet1")
    
    Dim sHwnd As String
    sHwnd = Application.hwnd & "`"
    
    Dim sMonikerPart1 As String
    
    If InStr(1, ThisWorkbook.FullName, " ", vbTextCompare) > 0 Then
        sMonikerPart1 = sHwnd & "'[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1'!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "'!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "'Sheet1!LocalName"
    Else
        sMonikerPart1 = sHwnd & "[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "Sheet1!LocalName"
    End If
    
End Sub



Private Sub Test_XlMoniker_GetExcelRange()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim vSetupValues As Variant
    vSetupValues = Application.[{"ColorName","ColorRGB";"Red","FF0000";"Green", "00FF00";"Blue" ,"0000FF"}]

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Value2 = vSetupValues

    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1") = "$A$1"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1:b4") = "$A$1:$B$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet2!B1:C4") = "$B$1:$C$4"

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Name = "GlobalName"
    
    Dim rngGlobalName As Excel.Range
    Set rngGlobalName = ThisWorkbook.Names.Item("GlobalName").RefersToRange
    
    
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]!GlobalName") = "$A$1:$B$4"
    ThisWorkbook.Worksheets("Sheet1").Range("B1:C4").Name = "Sheet1!LocalName"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!LocalName") = "$B$1:$C$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!$D5:E7") = "$D$5:$E$7"
End Sub

Private Function GetExcelRangeAddress(ByVal oMoniker As SimpleOLEDBProvider1.XlMoniker, ByVal sMoniker As String) As String
    Dim rng As Excel.Range
    Debug.Assert oMoniker.GetExcelRangeFromMoniker(sMoniker, rng)
    GetExcelRangeAddress = rng.Address
End Function

Private Sub Test_XlMoniker_GetExcelByHwnd()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim obj As Excel.Application
    If oMoniker.GetExcelByHwnd(Application.hwnd, obj) Then
        Debug.Assert obj Is Application
    End If


End Sub

Private Sub GlobalName()
    
    Dim namGlobal As Excel.Name
    Set namGlobal = ThisWorkbook.Names.Item("GlobalName")
    Debug.Assert Not namGlobal Is Nothing
    Debug.Assert namGlobal.RefersToRange.Address = "$A$1:$B$4"
    
    Dim namLocal As Excel.Name
    Set namLocal = ThisWorkbook.Worksheets("Sheet1").Names.Item("LocalName")
    Debug.Assert Not namLocal Is Nothing

    Dim namGlobal2 As Excel.Name
    Set namGlobal2 = ThisWorkbook.Names.Item("GlobalName")

    Stop

End Sub

XlMonikerParser Unit Tests

As promised here is the unit test code for the XlMonikerParser class. I must say I really like the testing support in Visual Studio 2017. Far better than unit tests in VBA!

using XlMoniker;
using Microsoft.VisualStudio.TestTools.UnitTesting;

namespace UnitTestProject1
{
    [TestClass]
    public class UnitTest1
    {
        [TestMethod]
        public void TestMethod1()
        {
            XlMonikerParser parser = new XlMonikerParser();
            string sHwnd;
            string sFileAndCellAddressMoniker;

            bool parsed = parser.ParseLeadingHwnd("1234`'[foo bar.xlsx]!Sheet1", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[foo bar.xlsx]!Sheet1");

            parsed = parser.ParseLeadingHwnd("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[Book With Space in Name.xlsx]Sheet1'!$D$3");

            parsed = parser.ParseLeadingHwnd("1234`TestClient.xlsm!GlobalName", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "TestClient.xlsm!GlobalName");
        }

        [TestMethod]
        public void TestMethod2()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbookAndSheet; string sCellAddress;

            bool parsed = parser.ParseWorkbookAndSheetFromCellAddress("'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "'[Book With Space in Name.xlsx]Sheet1'");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseWorkbookAndSheetFromCellAddress("TestClient.xlsm!GlobalName", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "TestClient.xlsm");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }

        [TestMethod]
        public void TestMethod3()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbook; string sWorksheet;

            bool parsed = parser.ParseWorkbookFromSheet("'[Book With Space in Name.xlsx]Sheet1'", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");

            parsed = parser.ParseWorkbookFromSheet("[TestClient.xlsm]Sheet2", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "Sheet2");

            parsed = parser.ParseWorkbookFromSheet("TestClient.xlsm", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
        }

        [TestMethod]
        public void TestMethod4()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sHwnd; string sWorkbook; string sWorksheet; string sCellAddress;

            bool parsed = parser.ParseMoniker("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseMoniker("1234`TestClient.xlsm!GlobalName", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }
    }
}