QR code generator modification

[amaresh achar]

Hi.. in search of a simple but reliable QR code generator... I came across an useful Excel macro tool from below link:

Can anyone please help me to get the QR code (black and white cell array) in spreadsheet cell instead of an image format..!?

Thank you very much in advance,
Amaresh

 

[CSmith]

What exactly do you mean by spreadsheet cell instead of image format?

 

[amaresh achar]

What I meant is... I want this QR code pixel matrix to be available as Excel cells instead of whole matrix as an image...

 

[John_w]

Try this macro, which adds the QR code shape in B1 (named $B$1 by the generator) as a cell comment picture in B7. Put the code in a new module.

Public Sub Add_Shape_As_Comment_Picture()

    Dim QRcode As Shape
    Dim tempImageFullName As String
    
    Set QRcode = Worksheets("Barcodes").Shapes("$B$1")
    
    tempImageFullName = Environ("temp") & "\" & QRcode.Name & ".bmp"
    Save_Object_As_Bitmap QRcode, tempImageFullName
    Add_Comment_Picture Worksheets("Barcodes").Range("B7"), tempImageFullName, QRcode.Width, QRcode.Height
    Kill tempImageFullName
    
End Sub


Private Sub Add_Comment_Picture(cell As Range, pictureFullName As String, pictureWidth As Single, pictureHeight As Single)
    
    Dim cellComment As Comment
        
    If Not cell.Comment Is Nothing Then cell.Comment.Delete
    Set cellComment = cell.AddComment
        
    'Add picture to comment
    
    With cellComment
        .Visible = True
        With .Shape
            .Left = cell.Left + 4
            .Top = cell.Top + 4
            .Width = pictureWidth
            .Height = pictureHeight
            .line.ForeColor.RGB = RGB(255, 255, 255)    'white to hide comment connector line
            .Fill.Transparency = 0#
            .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .Fill.UserPicture pictureFullName
        End With
    End With
    
End Sub


Private Sub Save_Object_As_Bitmap(saveObject As Object, imageFileName As String)

    'Save a bitmap of an object as a BMP file
    
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'imageFileName  - the .bmp file name (including folder path if required) the picture will be saved as
    
    Dim temporaryChart As ChartObject
     
    saveObject.CopyPicture xlScreen, xlBitmap
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
    With temporaryChart
        .Activate                                'Required, otherwise image is blank with Excel 2016
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export imageFileName
        .Delete
    End With    
    Set temporaryChart = Nothing
    
End Sub

 

[Shadkng]

Hi, I tried the code above and I am getting a debug error as follows but I don't know why? Where should I put the data for the code, B7? Thanks

Set QRcode = Worksheets("Barcodes").Shapes("$B$1")

 

[John_w]

I think the generator macro names the QR code/barcode shape after the cell (absolute reference) in which it sits, so if your barcode shape is in B7 try changing "$B$1" in the above code to "$B$7".

 

[abdelfattah]

@John_w I try following your instructions in your last post but unfortunately it gives error as in picture in this line

 Set QRcode = Worksheets("Barcodes").Shapes("$B$1")

despite of I put the picture barcode in cell B1 and I have serial number in B7 , what do you think ?

 

[John_w]

@John_w I try following your instructions in your last post but unfortunately it gives error as in picture in this line

 Set QRcode = Worksheets("Barcodes").Shapes("$B$1")

despite of I put the picture barcode in cell B1 and I have serial number in B7 , what do you think ?
View attachment 75097

That error suggests you haven't got a shape named "$B$1" on the "Barcodes" sheet.

With the serial number in B7, put the following formula in B1:

=QRcode(B7)

That calls the QRcode UDF which generates the QR code as a shape named "$B$1" in B1. My macro should now work.

 

[abdelfattah]

thanks John but shows error #NAME? in B1 after put the formula .

 

[John_w]

Have you downloaded the workbook from the Youtube video in the OP? My code should be put in a new module in that workbook.