Search code examples
excelvb.netactivexoffice-interop

Why does Microsoft Barcode Control break when the workbook is opened via interop?


I have a worksheet, to which I have added a QR code.

The QR code is an ActiveX control: Microsoft Barcode Control 14.0

The QR code is linked to a cell (A1), so that when the value in the cell changes, so does the QR code.

When I open the workbook normally, everything works as it should.

However, when I open it using Interop from a vb.net Winforms project, the QR code no longer responds when the value in the linked cell changes. Whats more, when I right click on the barcode control, the "Microsoft Barcode Control 14.0 Object" context menu option (seen below) is missing.

enter image description here

The interop code that I am using to open the workbook is as follows:

Dim XLApp As New Excel.Application
XLApp.Visible = True
Dim XLBook As Excel.Workbook = XLApp.Workbooks.Open(FilePath)

Can anyone tell me what is causing this to happen? And perhaps suggest what I can do to prevent it happening.


Solution

  • I could not get the Microsoft Barcode Control to function correctly with interop. One way would be to open the file using a shell command and then hook into the process to work with it. But I found this too messy.

    Instead, I decided to use google's Chart API. This does require an internet connection. But that is not a problem for me.

    Here is a link for more info: https://sites.google.com/site/e90e50fx/home/generate-qrcode-with-excel

    And the VBA code:

    Option Explicit
    'other technical specifications about google chart API:
    'https://developers.google.com/chart/infographics/docs/qr_codes
    
    Function URL_QRCode_SERIES( _
        ByVal PictureName As String, _
        ByVal QR_Value As String, _
        Optional ByVal PictureSize As Long = 150, _
        Optional ByVal DisplayText As String = "", _
        Optional ByVal Updateable As Boolean = True) As Variant
    
    Dim oPic As Shape, oRng As Excel.Range
    Dim vLeft As Variant, vTop As Variant
    Dim sURL As String
    
    Const sRootURL As String = "https://chart.googleapis.com/chart?"
    Const sSizeParameter As String = "chs="
    Const sTypeChart As String = "cht=qr"
    Const sDataParameter As String = "chl="
    Const sJoinCHR As String = "&"
    
    If Updateable = False Then
        URL_QRCode_SERIES = "outdated"
        Exit Function
    End If
    
    Set oRng = Application.Caller.Offset(, 1)
    On Error Resume Next
    Set oPic = oRng.Parent.Shapes(PictureName)
    If Err Then
        Err.Clear
        vLeft = oRng.Left + 4
        vTop = oRng.Top
    Else
        vLeft = oPic.Left
        vTop = oPic.Top
        PictureSize = Int(oPic.Width)
        oPic.Delete
    End If
    On Error GoTo 0
    
    If Len(QR_Value) = 0 Then
        URL_QRCode_SERIES = CVErr(xlErrValue)
        Exit Function
    End If
    
    sURL = sRootURL & _
           sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
           sTypeChart & sJoinCHR & _
           sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))
    
    Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
    oPic.Name = PictureName
    URL_QRCode_SERIES = DisplayText
    End Function
    
    
    Function UTF8_URL_Encode(ByVal sStr As String)    
        'http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp
        Dim i As Long
        Dim a As Long
        Dim res As String
        Dim code As String
    
        res = ""
        For i = 1 To Len(sStr)
            a = AscW(Mid(sStr, i, 1))
            If a < 128 Then
                code = Mid(sStr, i, 1)
            ElseIf ((a > 127) And (a < 2048)) Then
                code = URLEncodeByte(((a \ 64) Or 192))
                code = code & URLEncodeByte(((a And 63) Or 128))
            Else
                code = URLEncodeByte(((a \ 144) Or 234))
                code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
                code = code & URLEncodeByte(((a And 63) Or 128))
            End If
            res = res & code
        Next i
        UTF8_URL_Encode = res
    End Function
    
    
    Private Function URLEncodeByte(val As Integer) As String
        Dim res As String
        res = "%" & Right("0" & Hex(val), 2)
        URLEncodeByte = res
    End Function