QR Codes in Excel

[buteaur]

Does anyone know if there is either a Microsoft add on or, a reliable add on to have Excel create QR codes?

Thanks.

 

[shg]

From my attic ...

Sub Demo()
  Dim i             As Long

  For i = 1 To 6 Step 2
    MakeQRCode sData:="Now is the time for all good men to come to the aid of their country.", _
              iForeCol:=vbBlack, iBackCol:=vbWhite, iSize:=120, cell:=Cells(i, i)
  Next i
End Sub

Function MakeQRCode(sData As String, iForeCol As Long, iBackCol As Long, _
                   ByVal iSize As Long, cell As Range) As Boolean
  ' shg 2017
  
  ' VBA only
  
  ' Places a QR code of specified size (in pixels), containing the specified data
  ' (plain ASCII), at the top left of the specified cell
  
  ' Returns True if successful

  ' See http://goqr.me/api/doc/create-qr-code/ for API documentation
  
  Dim iPic          As Long
  Dim ****          As String
  Dim oPic          As Picture
  Dim sURL          As String

  ' Name as QRCode(n)
  On Error Resume Next
  Do
    Set oPic = Nothing
    iPic = iPic + 1
    **** = "QRCode(" & iPic & ")"
    Set oPic = cell.Worksheet.Pictures(****)
  Loop While Not oPic Is Nothing
  Err.Clear

  If iSize > 1000 Then iSize = 1000
  If iSize < 10 Then iSize = 10

  sURL = "https://api.qrserver.com/v1/create-qr-code/?" & _
         "&data=" & sData & _
         "&size=" & iSize & "x" & iSize & _
         "&charset-source=UTF-8" & _
         "&charset-target=UTF-8" & _
         "&ecc=L" & _
         "&color=" & sRGB(iForeCol) & _
         "&bgcolor=" & sRGB(iBackCol) & _
         "&margin=0" & _
         "&qzone=1" & _
         "&format=png"
  ' Debug.Print sURL

  With cell.Worksheet.Pictures.Insert(sURL)
    .Name = ****
    .Left = cell.Left
    .Top = cell.Top
  End With
  
  MakeQRCode = Err.Number = 0
End Function

Function sRGB(iRGB As Long) As String
  ' converts an RGB long to a hex string encoding RRGGBB
  sRGB = Right("00000" & Hex(iRGB), 6)
  sRGB = Right(sRGB, 2) & Mid(sRGB, 3, 2) & Left(sRGB, 2)
End Function

 

[shg]

That **** should be s P i c, sans spaces. The board thinks I'm being racially insensitive.

 

[buteaur]

Thanks for the reply. I'm going to give this a shot. I'll let you know!

 

[buteaur]

Am I being dumb? I put this in my visual basic and used some values. I don't see it doing anything.

Sorry

 

[shg]

I ran the code exactly as posted (well, after fixing the masked variable). It huddled for a few seconds and then pasted three QR codes.

 

[buteaur]

Okay. I'll try again. Thanks!

 

[buteaur]

Awesome! That worked. Can you use this to direct to specific cells to read text or can you only use it for specific text, "Mow is the time for all good men to come to the aid of their country"

Thank you!

 

[Zenwood]

Thanks for the code. I was able to create a QR for our companies address in about a minute.

I wounder how many characters you can get into a QR code.

 

[shg]

I wounder how many characters you can get into a QR code.

That should motivate you to read the information at the link.