excel - 尝试在工作表上对形状进行分组时出现“未找到具有指定名称的项目”错误
问题描述
我正在编写一个 VBA 程序来选择性地对一些圆角矩形进行分组。将有这些组的集合,所以我想将它们存储在一个数组中。(例如,我想让 dataSeriesGroup(1) 拥有一组例如三个圆角矩形,dataSeriesGroup(2) 拥有一组其他三个圆角矩形,依此类推)。我正在尝试使用 .Name 属性将它们分配给组,如下所示:
Dim ctr, ctr2, seriesCount, dataCount as Integer
Dim dataSeriesGroup() as Shape
Dim dataPoint() as Shape
Dim dTop, dLeft, dWidth, dHeight as long
Dim dataPointName as Variant
<Bunch of code to calculate values of dTop, dLeft, dWidth, dHeight, seriesCount, dataCount>
Redim dataSeriesGroup(seriesCount)
Redim dataPoint(dataCount, dataSeriesCount)
Redim dataPointName(dataCount)
For ctr = 1 to seriesCount
For ctr2 = 1 to dataCount
Set dataPoint(ctr2, ctr) = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, dLeft, dTop, dWidth, dHeight)
dataPointName(ctr2) = dataPoint(ctr2, ctr).Name
Next ctr2
Set dataSeriesGroup(ctr) = Activesheet.Shapes(Array(dataPointName)).Group
Next ctr
一切正常,但是当我尝试设置 dataSeriesGroup(ctr) 时出现错误“运行时错误'-2147352571 (80020005)':找不到具有指定名称的项目。”
有人可以就我做错了什么提供一些指导吗?
解决方案
问题在于datapointName
声明变量的方式。您想要构建一个与函数返回的行为相同的数组,该Array
函数返回一个从零开始的 Variants 数组:
Dim datapointName() As Variant '<== Notice the parentheses.
小心 ReDims,因为您通常不希望在数组的远端悬空 Empty 值,因此:
ReDim dataPointName(0 To dataCount - 1) '<== That's dataCount elements!
另请参阅下面示例代码中有关变量声明的注释。
最后,使用集合的Range
属性Shapes
获取子集,并删除对 的调用Array()
,因为 dataPointName 已经是:
Set dataSeriesGroup(seriesIndex) = ActiveSheet.Shapes.Range(dataPointName).Group
综上所述,这里有一些基于您的功能演示代码:
Sub DoTheShapesThing()
'Note: in VBA, to each variable its type; otherwise: Variant.
'I've renamed some variables for clarity.
Dim seriesIndex As Integer
Dim dataIndex As Integer
Dim seriesCount As Integer
Dim dataCount As Integer
Dim dataSeriesGroup() As Shape
Dim dataPoint() As Shape
'Haven't altered your position and size variables, but the type should typically be Double.
Dim dTop As Long
Dim dLeft As Long
Dim dWidth As Long
Dim dHeight As Long
Dim dataPointName() As Variant '<== Here, the parentheses make all the difference! You want an array of Variants, just like the Array function returns.
'I've added this declaration for the code to compile. REMOVE IT! You've probably declared this variable elsewhere.
Dim dataseriesCount As Long
'Test values...
seriesCount = 2
dataCount = 2
dataseriesCount = seriesCount '<== Note that dataseriesCount must be >= seriesCount so the code below doesn't go "Subscript out of range".
dLeft = 100: dTop = 100: dWidth = 100: dHeight = 100
ReDim dataSeriesGroup(0 To seriesCount - 1)
ReDim dataPoint(0 To dataCount - 1, 0 To dataseriesCount - 1)
ReDim dataPointName(0 To dataCount - 1)
For seriesIndex = 0 To seriesCount - 1
For dataIndex = 0 To dataCount - 1
'Took some liberties with shape disposition here...
Set dataPoint(dataIndex, seriesIndex) = ActiveSheet.Shapes.AddShape( _
msoShapeRoundedRectangle, _
dLeft + 10 * (seriesIndex + dataIndex), _
dTop + 10 * (seriesIndex + dataIndex), _
dWidth, _
dHeight)
dataPointName(dataIndex) = dataPoint(dataIndex, seriesIndex).Name
Next dataIndex
Set dataSeriesGroup(seriesIndex) = ActiveSheet.Shapes.Range(dataPointName).Group
Next seriesIndex
End Sub
推荐阅读
- r - 如何使用带有日期的 rownames_to_column
- java - 使用 Libgdx 和 Kryonet 分离 main() 方法来运行 DesktopLauncher.main() 和 Server
- django - 带有过滤条件的三个模型中的 Django Select
- python - numpy.gradient 函数的逆
- google-apps-script - 更改单元格中的文本后自动复制信息
- flask - 当代码指示要写入的文件时,apache2/mod_wsgi/python3/flask 使用什么凭据?
- python - 如何将边缘数据集重建为常规 pandas 数据框?
- c - C中的定时器线程
- javascript - JS 不会重新计算应用折扣的最终价格
- .htaccess - PHP 使用 .htaccess 拆分后端、前端和 API