VBA Coding for QR Code

Hello,
I want to generate QR code from the value (Text and number) which will be there in one Cell of excel sheet. QR Code should be updated when the value of the cell changes. QR should not be updated automatically, there should be update button which can be used/clicked for updating QR code.

Thanks in advance

Originally Posted by TMS

Maybe https://www.extendoffice.com/documen...e-qr-code.html

Thanks for reply. Can you please provide VBA code in which source cell and output cell will be pre-determine in VBA code? Also it will be great if i need not to add any add-ons for this. To generate QR code, i will click button which will create QR code. So if possible give button for that which will be micro assigned. Thanks.

Originally Posted by TMS

Maybe https://www.extendoffice.com/documen...e-qr-code.html

As per this, i will have to download barcode control. I just want to say that, is it possible to have simple VBA code for QR code which will not be needed any download?

Somewhere on internet i found below code but this code automatically update info. Also size of QR code and cell reference is difficult to understand. Can you alter this code so that i can use it manually (Not automatically) and create QR code at desired cell location?

Option Explicit

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)
   
    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

Originally Posted by TMS

It would probably help everyone if you'd provided the link to the site where you found the code.

I'm guessing this is it: https://sites.google.com/site/e90e50...ode-with-excel

Looks as though you put the function, URL_QRCode_SERIES, in a cell and the QR Code will be created in the next cell. The output cell is determined by Set oRng = Application.Caller.Offset(, 1), so you can probably adjust those offsets.

It all looks pretty straightforward.

THANKS FOR REPLY, this code works well but it slows down my excel file. It works on formula and hence continuously update QR code when i change value of any cell, i think because of this, it is slowing down my excel file. Do u have any solution for this? I have also tried Code given on https://stackoverflow.com/questions/...sing-excel-vba but and also good and do not slow down my file but when i try to save my excel file, file stop to responds and close down.


If possible please give solutions to above problems. Thanks.

Originally Posted by TMS

It would probably help everyone if you'd provided the link to the site where you found the code.

I'm guessing this is it: https://sites.google.com/site/e90e50...ode-with-excel

Looks as though you put the function, URL_QRCode_SERIES, in a cell and the QR Code will be created in the next cell. The output cell is determined by Set oRng = Application.Caller.Offset(, 1), so you can probably adjust those offsets.

It all looks pretty straightforward.

Also it require internet connection. Can we do it in offline mode?