Sub SetQR(stringToQR As String, rngCode As Range)
Dim sht As Worksheet
Dim shpTmp As Shape
Dim xRRg As Range
Dim xObjOLE As OLEObject
Set sht = rngCode.Parent
On Error Resume Next
Set xRRg = rngCode
Set xObjOLE = sht.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
xObjOLE.Object.Style = 11
xObjOLE.Object.Value = stringToQR
sht.Shapes.Item(xObjOLE.Name).Width = xRRg.Width * 10
sht.Shapes.Item(xObjOLE.Name).Height = xRRg.Height * 10
sht.Shapes.Item(xObjOLE.Name).Copy
sht.Paste xRRg
xObjOLE.Delete
sht.Shapes(1).Top = xRRg.Top
sht.Shapes(1).Left = xRRg.Left
sht.Shapes(1).Width = xRRg.Width
sht.Shapes(1).Height = xRRg.Height
End Sub