Basic QR generator from qrplatba.cz

qrCodeGenerator.bas

Sub URLPictureInsert()

    'promenne
    Dim Qr As Shape
    Dim xRg As Range
    Dim xCol As Long
    Dim xRow As Long
    
    On Error Resume Next
        Application.ScreenUpdating = False

    'Načtení URL z buňky aktivního listu
    Set Rng = ActiveSheet.Range("J9 ")
    
    'Cyklus - nemusel by tu být ale lze pak generovat více QR kodu najednou
    For Each cell In Rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Qr = Selection.ShapeRange.Item(1)
        xCol = cell.Column - 6
        xRow = cell.Row + 3
        Set xRg = Cells(xRow, xCol)
    
        If Qr Is Nothing Then GoTo lab
        
    With Qr
        'zamčeni poměru stran a nastavení šířky
        .LockAspectRatio = msoTrue
        .Width = 100
        .Top = xRg.Top
        .Left = xRg.Left
    End With
    
'Když dojde k chybě smaž QR a ulož null
lab:
    Set Qr = Nothing
    Range("D22").Select
    Next
    Application.ScreenUpdating = True
    
End Sub