将所有形状生成到特定大小的VBA和Excel
将所有形状生成到特定大小的VBA和Excel
提问于 2022-06-20 07:43:19
为部件标签构建一个QR生成器，并试图对该生成器进行愚蠢的验证，以便多个操作符可以在打印出标签时使用它，下面的代码如下：
生成QR码
‘函数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结束子对象
当我试图复制它，更改单元名称时，我得到了错误Ambiguous name detected: Worksheet_Calculate()，如何修复这个错误呢？
回答 1
Stack Overflow用户
回答已采纳
发布于 2022-06-22 10:20:44
知道了如何单独做这件事，下面是代码
资料来源:各种在线
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端函数
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72683738
复制相关文章
相似问题
腾讯云开发者
