生成指定大小的所有形状，VBA和Excel

Question

为零件标签构建QR生成器，并尝试白痴证明生成器，以便多个操作员可以在打印标签时使用它，代码如下:

使用

生成二维码'函数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

结束功能

'我可以在单独的工作表上生成一个形状的大小，如下所示:

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

结束子

当我试图复制这个，改变单元格名称，我得到错误Ambiguous name detected: 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

结束功能