Generate all shapes to a specific size, VBA and Excel

Question

Building a QR generator for part tags and trying to idiot proof the generator so multiple operators can use it when printing out tags, code below:

Generating the QR codes With

' Function GenerateQR(qrcode_value As String)

Dim URL As String
Dim My_Cell As Range

Set My_Cell = Application.Caller
URL = "https://chart.googleapis.com/chart?chs=100x100&&cht=qr&chl=" & qrcode_value
On Error Resume Next
  ActiveSheet.Pictures("My_QR_CODE_" & My_Cell.Address(False, False)).Delete
On Error GoTo 0
ActiveSheet.Pictures.Insert(URL).Select
With Selection.ShapeRange(1)
 .Name = "My_QR_CODE_" & My_Cell.Address(False, False)
 .Left = My_Cell.Left
 .Top = My_Cell.Top
End With
GenerateQR = ""

Set shapetocrop = ActiveSheet.Shapes.Range(Array("My_QR_CODE_A1"))
    With shapetocrop.Duplicate
        .ScaleHeight 1, True
        origHeight = .Height
        .Delete
    End With
croppoints = origHeight * 17 / 100
shapetocrop.PictureFormat.CropLeft = croppoints
shapetocrop.PictureFormat.CropRight = croppoints
shapetocrop.PictureFormat.CropTop = croppoints
shapetocrop.PictureFormat.CropBottom = croppoints

End Function

` And i can generate the size of one shape on a separate sheet with the following:

Private Sub Worksheet_Calculate()
With ActiveSheet.Shapes.Range(Array(MY_QR_CODE_A1))
.Width = Range("F1").Value
.Height = Range("F1").Value
End With

End Sub

When i attempt to replicate this, changing the cell name i get the error Ambiguous name detected: Worksheet_Calculate() how can i fix this?

Answer 1

Figured out how to do this alone so here is the code

Source: Various online

Function GenerateQR(qrcode_value As String)

'Generating the QR'

Dim URL As String
Dim My_Cell As Range

Set My_Cell = Application.Caller
URL = "https://chart.googleapis.com/chart?chs=100x100&&cht=qr&chl=" & qrcode_value
'Uses Google API'
On Error Resume Next
  ActiveSheet.Pictures("My_QR_CODE_" & My_Cell.Address(False, False)).Delete
On Error GoTo 0
ActiveSheet.Pictures.Insert(URL).Select
With Selection.ShapeRange(1)
'Position the QR'
 .Name = "My_QR_CODE_" & My_Cell.Address(False, False)
 .Left = My_Cell.Left - 30
 .Top = My_Cell.Top - 10

 
End With
GenerateQR = ""
'Crop QR'
Set shapetocrop = ActiveSheet.Shapes.Range(Array("My_QR_CODE_" & My_Cell.Address(False, False)))
    With shapetocrop.Duplicate
        .ScaleHeight 0.8, True
        origHeight = .Height
        .Delete
    End With
    croppoints = origHeight * 17 / 100
    shapetocrop.PictureFormat.CropLeft = croppoints
    shapetocrop.PictureFormat.CropRight = croppoints
    shapetocrop.PictureFormat.CropTop = croppoints
    shapetocrop.PictureFormat.CropBottom = croppoints

End Function