生成所有形状的特定尺寸，VBA和Excel

Question

构建用于零件标签的QR生成器并试图证明发电机时，多个操作员可以在打印标签时使用它，以下代码：

生成QR码

与' function generateqr（qrcode_value作为字符串）

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

结束

函数 而且我可以在单独的表格上生成一个形状的大小，并具有以下内容：

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

尝试复制此形状，更改单元格名称，我收到错误检测到的模棱两可的名称：worksheet_calculate（）如何能如何我修复了吗？

Answer 1

弄清楚了如何单独执行此操作，所以这里是代码

源：各种在线

Function GenerateQR(qrcode_value As String)

'生成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

结束函数