QR Code connundrum

YansaneYansane

New Member
Joined
Nov 1, 2024
Messages
34
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
Hi Tech,

I have this code to Generate a QR Code... :eek:
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

===============================
 

Attachments

  • Table N.jpg
    Table N.jpg
    68.7 KB · Views: 13

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,225,204
Messages
6,183,577
Members
453,170
Latest member
sameer98

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top