Generate a dynamic image link and Display in Sheet using VBA

[Restyl]

I want to use Google Chart API to generate QR codes based on a cell value. Here is what my sheet looks like:

My VBA code automatically generates the Stock Number every time the part # is changed. I need the QR Code column to be a QR code for the Stock Number to the right of it. I pasted the values of the Stock Number column in the QR Code Column to symbolize what the QR Code's encoded value should be.

How can I use Google Charts' API to generate a QR Code for each entry based on the Stock Number, and display the actual image in my sheet in the QR code column using VBA?

https://chart.googleapis.com/chart?chs=150x150&cht=qr&chl=I1&choe=UTF-8

 

[Restyl]

I decided to just resize the Column Width... don't ask why I didn't do that before!! (facepalm)

I'm having one last issue. Here is a picture after I've used my Stock Search Sheet (which searches for criteria matches in the Stock_DB sheet):
The light blue row is the criteria row. In this case, I typed in NDS-11 Part # and clicked the Search button in the top right corner:

Everything is fine here, and it looks great. My issue is when I click the Clear Results or Clear All button, the QR Code image object still remains:

Here are my Clear Results and Clear All macros

Sub Clear_Results()
' Clear search results
' Clears only the results from previous search
' Recorded 10/28/2016 by saji
    If WorksheetFunction.CountA(Range("B4:I20000")) = 0 Then
        MsgBox "There is no data to clear!"
    Else
        Range("B3:I20000").Select
        Selection.ClearContents
        Sheets("STOCK SEARCH").Range("B4").EntireRow.Delete
        Range("D3").Select
    End If
End Sub
Sub Clear_All()
' Clear all search results
' Clears the results & criteria from previous search
' Recorded 10/28/2016 by saji
    If WorksheetFunction.CountA(Range("B3:I20000")) = 0 Then
        MsgBox "There is no data to clear!"
    Else
        Range("B3:I20000").Select
        Selection.ClearContents
        Sheets("STOCK SEARCH").Range("B4").EntireRow.Delete
        Range("D3").Select
    End If
End Sub

I've also noticed that the QR Code Image is NOT attached to the cell, meaning I can slide it around and place it anywhere in the sheet. How can that be fixed? I think these two issues might be hand in hand somehow..

 

[Kenneth Hobson]

To protect your objects from moving around, you should protect the sheet. Of course then you have to unprotect/protect the sheet(s) for each code change too. The better way though is to let the code change anything it wants. The key to do that is worksheets Protect method with the UserInterfaceOnly option. I put this in my ThisWorkbook object. Change ken to suit and the loop to just do one sheet or a set of sheets or all as I did.

Private Sub Workbook_Open()
  Dim ws As Worksheet
  For Each ws In Worksheets
    ws.Protect "ken", UserInterfaceOnly:=True 'True allows code to change data.
  Next ws
End Sub

I do recommend disabling events and such in your event code and your clear data routines.

To delete the shape objects, I made it easy for you. I named them "QR x" were x is the A1 cell notation. There are several ways to do that. One is to iterate all shapes and IF the shape's name left 3 characters are "QR " then the code would delete it. Another method is that if your range to delete is known, several ways to do that without hard coding the last row, then delete the shape named "QR " & acell.address(false, false).

I'll post some examples of my comments above later tonight.

 

[Kenneth Hobson]

Always test on a backup copy of your file.

Right click the sheet's tab, View > Code, and paste. Rename your change event to say Change1 to test this change event.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, c As Range
   
  On Error GoTo EndSub
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
     
  Set r = Intersect(ActiveSheet.Columns(4), Target)
  If r Is Nothing Then Exit Sub
   
  For Each c In r
    With c
      If .Offset(0, 5).Value = "" Then _
        .Offset(0, 5).Value = Application.WorksheetFunction.Max(Columns("I")) + 1
      If .Offset(0, 4).Value = "" Then _
        QRcodeToPicUTF8 .Offset(0, 5), Environ("temp"), _
          "QR " & ActiveCell.Address(False, False), .Offset(0, 4)
        'QRcodeToPicUTF8(url As String, pngPath As String, _
          pngName As String, aRange As Range, _
          Optional size As Integer = 150)
          'Pixel Size S, M, L: 160, 260, 360
    End With
  Next c
     
EndSub:
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub

In a Module, here is one way to delete all shapes with names with a prefix "QR ".

Sub DelAllQRshapes()
  Dim s As Shape

  On Error GoTo EndSub
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
   
  For Each s In ActiveSheet.Shapes
    If Left(s.Name, 3) = "QR " Then s.Delete
  Next s
     
EndSub:
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub

 

[Restyl]

Thanks Kenneth!

 

[nkendri24]

Hello Kenneth and Restyl,

Is there a function you use or does the QR code populate once the cell updates?
I am interested in something similar but "=concatenate" a series of cells and then display that as a QR code on a different sheet which I will print off.

Wondering if either of you could help

Thank you

 

[Kenneth Hobson]

Welcome to the forum!

IF you want to deal with formula changes, use the Calculate event. You still need to know what the dependent cells that will change are to take appropriate action. Here is one example. https://www.mrexcel.com/forum/excel...ctivate-macro-one-worksheet-change-event.html

 

[nkendri24]

Thank you!

I am still unable to acquire a QR code while using the VBA code from above.
The QR code will populate cell K:3 to K:83
and pull information from J:3 to J:83

If you could help that would be greatly appreciated

 

[nkendri24]

<p>Private Declare Function URLDownloadToFile Lib "urlmon" _<br>Alias "URLDownloadToFileA" (ByVal pCaller As Long, _<br>ByVal szURL As String, ByVal szFileName As String, _<br>ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long<br> <br>Function DownloadFile(url As String, LocalFileName As String) As Boolean<br>    If URLDownloadToFile(0, url, LocalFileName, 0, 0) = 0 Then<br>        DownloadFile = True<br>    End If<br>End Function</p><p>Sub QRcodeToPicUTF8(url As String, pngPath As String, _<br>  pngName As String, aRange As Range, _<br>  Optional size As Integer = 150)<br>  'Pixel Size S, M, L: 160, 260, 360<br>  <br>  Dim pngFN As String, s As Shape, sName As String<br>  <br>  If Right(pngPath, 1) <> "\" Then pngPath = pngPath & "\"<br>  If Len(Dir(pngPath)) = 0 Then<br>    MsgBox pngPath & " does not exist.", vbCritical, "Macro Ending"<br>    Exit Sub<br>  End If<br>  <br>  pngFN = pngPath & pngName & ".png"<br>  DownloadFile "<a href="http://chart.apis.google.com/chart?cht=qr&chs">http://chart.apis.google.com/chart?cht=qr&chs</a>=" & _<br>    size & "x" & size & "&chl=" & url & "&choe=UTF-8", pngFN<br>      <br>  If Len(Dir(pngFN)) = 0 Then<br>    MsgBox pngFN & " does not exist.", vbCritical, "Macro Ending"<br>    Exit Sub<br>  End If<br>  <br>  On Error Resume Next<br>  sName = "QR " & aRange.Address(False, False)<br>  ActiveSheet.Shapes(sName).Delete<br>  <br>  'Fit to aRange<br>  'Set s = ActiveSheet.Shapes.AddPicture(pngFN, _<br>    msoFalse, msoCTrue, aRange.Left, aRange.Top, _<br>    aRange.Width, aRange.RowHeight)<br>    <br>  'Fit to set dimensions: 150x150 pixels, _<br>    Row height: 36, Column Width: 4.29<br>  Set s = ActiveSheet.Shapes.AddPicture(pngFN, _<br>    msoFalse, msoCTrue, aRange.Left, aRange.Top, _<br>    77.25, aRange.Height)<br>  s.Name = sName<br>End Sub</p>

 

[Kenneth Hobson]

You have to decide on an image naming convention as I explained in post #12 . I would probably go with the row changed like, "QR 3" for row 3. It would be wasted effort to delete all images anytime a cell was changed. The better way would be to suffix by some other unique cell value in that row as rows can be added or deleted and would throw off the picture naming convention assumption.

I don't know what your post #18 is about. It just repeats API code posted in #9 , I guess. All of #9 goes into a Module. All you are left to do then is add the Calculate event similar to what I did in #13 but with #16 method.

Since this forum does not allow file attachments, I don't know how to give you a specific example. You need to explain, what cell values are and what the formulas are with real data for at least one row maybe.

 

[nkendri24]

I =concatenate(A3:I3) in cell J3 and want this imformation to be displayed in a QR code in K3. I have 81 cells going down and want each one to auto populate once the concatenate is complete.