QR-generator och Excel

filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(3, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath)
        .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
        .Left = ActiveSheet.Range("I1").Left
        .Top = ActiveSheet.Range("C4").Top
        .Width = ActiveSheet.Range("A1:B1").Width
        .Height = ActiveSheet.Range("A1:A5").Height
        .Placement = 1
    End With

cht = qr
chs = width x height
chl = data

https://chart.googleapis.com/chart?cht=qr&chs=150x150&chl=kalle_kula

Sub addQR()

    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic

    filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(3, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath)
        .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
        .Left = ActiveSheet.Range("I1").Left
        .Top = ActiveSheet.Range("C4").Top
        .Width = ActiveSheet.Range("A1:B1").Width
        .Height = ActiveSheet.Range("A1:A5").Height
        .Placement = 1
    End With
    
    filepath2 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(5, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath2)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("G11").Left
    .Top = ActiveSheet.Range("G11").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
        filepath3 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(7, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath3)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("E21").Left
    .Top = ActiveSheet.Range("E21").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
        filepath4 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(9, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath4)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("L21").Left
    .Top = ActiveSheet.Range("L21").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
    picPath = "O:\Robin\Dokument\logga.jpg"
    
With ActiveSheet.Pictures.Insert(picPath)
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.ScaleWidth 1.78, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 1.24, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("B3").Left
    .Top = ActiveSheet.Range("B3").Top
    .Placement = 1
  End With
    
End Sub

Sub setQR()
'Updated by Extendoffice 2018/8/22
    Dim xSRg As Range
    Dim xRRg As Range
    Dim xObjOLE As OLEObject
    On Error Resume Next
    Set xSRg = Application.InputBox("Please select the cell you will create QR code based on", "Kutools for Excel", , , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    Set xRRg = Application.InputBox("Select a cell to place the QR code", "Kutools for Excel", , , , , , 8)
    If xRRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = xSRg.Text
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste xRRg
    xObjOLE.Delete
    Application.ScreenUpdating = True
End Sub

    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic

    Dim xObjOLE As OLEObject
    On Error Resume Next

    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = [R3].Text
    xObjOLE.Width = 100
    'xObjOLE.ShapeRange.Fill.Transparency = 1
    'xObjOLE.Border.Weight = 0
    
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste Destination:=Worksheets("Blad1").Range("I4")
    xObjOLE.Delete
    Application.ScreenUpdating = True

xObjOLE.Object.Borderwidth = 0
xObjOLE.Object.Borderheight = 0