QR Code connundrum

[YansaneYansane]

Hi Tech,

I have this code to Generate a QR Code...
Please any help to make it work. Thanks

I have an 11-column table. Data from the previous 10 columns to be concatenated into a QR Code and inserted into the 11th column, column "M".
===============================
Sub InsertQRCode()
Dim ws As Worksheet
Dim lastRow As Long
Dim qrContent As String
Dim qrURL As String
Dim qrImg As Picture
Dim cell As Range
Dim qrWidth As Long, qrHeight As Long
Dim imgTop As Double, imgLeft As Double
Set ws = ThisWorkbook.Sheets("Dash")
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
For Each cell In ws.Range("B10:B" & lastRow)
qrContent = ""
For i = 2 To 12 ' Columns B to L are columns 2 to 12
qrContent = qrContent & ws.Cells(cell.Row, i).Value & " "
Next i
qrContent = WorksheetFunction.EncodeURL(qrContent)
qrURL = "https://chart.googleapis.com/chart?chs=150x150&cht=qr&chl=" & qrContent
Debug.Print qrURL
On Error Resume Next ' In case of URL issues
Set qrImg = ws.Pictures.Insert(qrURL)
On Error GoTo 0 ' Reset error handling
If Not qrImg Is Nothing Then
qrWidth = 100 ' Define desired width (adjust as necessary)
qrHeight = 100 ' Define desired height (adjust as necessary)
qrImg.ShapeRange.LockAspectRatio = msoFalse
qrImg.Width = qrWidth
qrImg.Height = qrHeight
imgTop = ws.Cells(cell.Row, "M").Top + (ws.Cells(cell.Row, "M").Height - qrHeight) / 2
imgLeft = ws.Cells(cell.Row, "M").Left + (ws.Cells(cell.Row, "M").Width - qrWidth) / 2
qrImg.Top = imgTop
qrImg.Left = imgLeft
Else
MsgBox "Failed to insert QR Code for row " & cell.Row, vbCritical
End If
Next cell
End Sub
===============================

 

[Logit]

I discovered google apparently no longer supports the creation of QR codes. Here is an edited version that uses a different URL for the QR code creation :

Option Explicit

Sub GenerateQRCodes()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim concatenatedData As String
Dim qrCodeURL As String

' Set the worksheet to work on
Set ws = ThisWorkbook.Sheets(1) ' Adjust the sheet number/name as needed

' Find the last row in column A with data
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Loop through each row and concatenate columns A to K
For i = 2 To lastRow ' Assuming row 1 has headers
concatenatedData = ""

' Concatenate data from columns A to K
Dim j As Integer
For j = 1 To 11
concatenatedData = concatenatedData & ws.Cells(i, j).Value & " "
Next j
concatenatedData = Trim(concatenatedData) ' Remove trailing spaces

' Generate the QR code URL using GoQR.me API
qrCodeURL = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & WorksheetFunction.Substitute(concatenatedData, " ", "%20")

' Insert the QR code as a hyperlink in column M
On Error Resume Next
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 13), Address:=qrCodeURL, TextToDisplay:="QR Code"
On Error GoTo 0
Next i

MsgBox "QR codes generated successfully!", vbInformation
End Sub

 

[YansaneYansane]

Hi Logit,

Thanks for the answer. The code runs, but populates 60 or so "empty" rows...in the column M, the right column. ....whereas only the rows or records with cell values, not empty, need to be concatenated into the QR Code.
Then its not the QR Code that is inserted, but the text "QR Code"..

Please advise. Thanks. again.

 

[Logit]

The test is a link to the website to download the qr code. Click on it.

 

[Logit]

Here is an upgraded version. It auto pastes the QR code in the sheet :

Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub GenerateQRCodes()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim concatenatedData As String
    Dim qrCodeURL As String
    Dim qrCodePath As String
    Dim qrCode As Picture
    Dim rowHeight As Double

    ' Set the worksheet to work on
    Set ws = ThisWorkbook.Sheets(1) ' Adjust the sheet number/name as needed

    ' Find the last row in column A with data
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Loop through each row and concatenate columns A to K
    For i = 2 To lastRow ' Assuming row 1 has headers
        concatenatedData = ""
        
        ' Concatenate data from columns A to K
        Dim j As Integer
        For j = 1 To 11
            concatenatedData = concatenatedData & ws.Cells(i, j).Value & " "
        Next j
        concatenatedData = Trim(concatenatedData) ' Remove trailing spaces

        ' Generate the QR code URL using GoQR.me API
        qrCodeURL = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & WorksheetFunction.Substitute(concatenatedData, " ", "%20")
        
        ' Define a temporary file path to save the QR code image
        qrCodePath = Environ("TEMP") & "\QRCode_" & i & ".png"

        ' Download the QR code image to the file path
        On Error Resume Next
        URLDownloadToFile 0, qrCodeURL, qrCodePath, 0, 0
        On Error GoTo 0

        ' Insert the QR code image into column M
        Set qrCode = ws.Pictures.Insert(qrCodePath)

        ' Resize the image to 150x150 (or adjust if necessary)
        With qrCode
            .ShapeRange.LockAspectRatio = msoFalse
            .Height = 150
            .Width = 150
            .Top = ws.Cells(i, 13).Top
            .Left = ws.Cells(i, 13).Left
        End With

        ' Adjust the row height to match the QR code height
        rowHeight = qrCode.Height
        ws.Rows(i).RowHeight = rowHeight
    Next i

    MsgBox "QR codes generated successfully!", vbInformation
End Sub

 

[YansaneYansane]

Hi Logit,

The code runs. I'm using Excel 2019, which is still fine.

1- I get an Execution Error (1004).
2- The QR Code is generated, but not in Column "M".
3- Trying to get a QR Code for each line item in Colum, "M", centered to fit.

Thanks

 

[Logit]

I don't understand the error. Works fine here. ???

Layout your sheet like this :

 

[YansaneYansane]

I don't understand the error. Works fine here. ???

Layout your sheet like this :

Oh wow...

Here's below the layout I have...

It pops the QR Code (i, 13). ....ideally, line-up by record-line item. in Column "M", centered to fit.


Thanks

 

[YansaneYansane]

I don't understand the error. Works fine here. ???

Layout your sheet like this :

Ideal setup.......

 

[Logit]

What row are the headers located ?