Excel VBA：如何将工作表上的所有当前形状添加到ShapeRange？

有点VBA新手在这里。Excel VBA：如何将工作表上的所有当前形状添加到ShapeRange？

很清楚，我如何创建一个ShapeRange使用单个或多个Shape对象：

Dim sht As Worksheet 
Set sht = MySht 
' 
'*Add some shapes* 
' 
Dim shprng As ShapeRange 
Set shprng = sht.Shapes.Range(Array(1,2,3))

有没有办法在工作表上添加所有当前存在的形状，以shprng？换句话说，是否有一种方法可以从Shapes对象返回ShapeRange ...？类似这样的：

Set shprng = sht.Shapes.Range.SelectAll '<--- Does not work: Type Mismatch 
Set shprng = sht.Shapes     '<--- Same error 
Set shprng = sht.Shapes.Range   '<--- Error: Argument not optional

谢谢！

来源

2014-02-19 Rick Teachey

如果要通过选择表单上的所有形状来创建ShapeRange，首先要选择它们，然后从Selection对象中获取ShapeRange。

sht.Shapes.Range.SelectAll 
Set shprng = Selection.ShapeRange

我通常不喜欢使用VBA中的选择对象，因为它往往是片状，并可能导致怪异的情况下错误。我认为更好的方法是构建一个Shape索引数组，并使用该数组获取ShapeRange。

Dim shape_index As Variant 
Dim i As Long 

ReDim shape_index(1 To sht.Shapes.Count) 
For i = 1 To UBound(shape_index) 
    shape_index(i) = i 
Next 

Set shprng = sht.Shapes.Range(shape_index)

来源

2014-02-19 17:11:33 Tmdean

谢谢 - 完成了我所要做的。你碰巧知道'Shapes'集合对象是否是一个主动维护的对象向量？我的意思是：说'sht.Shapes.Count = 5'，我要做'sht.Shapes（2）。删除'; 'sht.Shapes.Count'现在等于4，并且'形状（3）'和'形状（4）'现在变成2和3了吗？ –

是的，Shapes对象将按照您所描述的自动更新。 – Tmdean

注意：两个形状可以具有相同的名称，在这种情况下，您的代码将失败。通过添加形状以shprng这种方式绕过：'shprng.select：sht.Shapes（i）.select replace：= false：set shprng = selection.shaperange'。如果activesheet是形状所在的工作表，则工作。 –

Excel VBA：如何将工作表上的所有当前形状添加到ShapeRange？

回答

相关问题