Excel VBA：如何从ChartObject获取对Shape的引用

我正在尝试获取对Worksheet的Shape ，对应于ChartObject的引用。 我发现没有这样做的某种方式。 通过反复试验和仅在less数情况下进行简单testing的唯一近似就是假设ChartObject的ZOrder与相应Shape的Index相同：

 Function chobj2shape(ByRef cho As ChartObject) As Shape ' It appears that the ZOrder of a ChartObject is the same as the Index of ' the corresponding Shape, which in turn appears to be the same as its ZOrderPosition Dim zo As Long Dim ws As Worksheet Dim shc As Shapes Dim sh As Shape zo = cho.ZOrder Set ws = cho.Parent Set shc = ws.Shapes Set sh = shc.Item(zo) Set chobj2shape = sh 'Set sh = Nothing End Function 

（为了debugging目的，使用稍微多余的定义variables）。

有没有更多的方法来做到这一点？

任何用于挑选正确Shape标识符都应该是唯一的。 名称不一定是唯一的（请参阅https://stackoverflow.com/questions/19153331/duplicated-excel-chart-has-the-same-name-name-as-the-original-instead-of-increm ），所以它不保证工作。 Index / ZOrderPosition只是一个猜测，至less可以满足唯一性的要求。

编辑 ：请参阅Excel中的@Andres的答案VBA：Index = ZOrderPosition在Shapes集合中？ 。 很明显， ChartObject的ZOrder不等于ChartObject或相应Shape的Index （我已经validation了这一点）。 但是看起来ZOrder等于相应Shape ZOrderPosition 。 这已通过dump_chartobjects进行validation：

 Sub dump_chartobjects() ' Dump information on all ChartObjects in a Worksheet. Dim coc As ChartObjects Set coc = ActiveSheet.ChartObjects Dim cho As ChartObject Dim ich As Long For ich = 1 To coc.Count Dim msg As String Set cho = coc(ich) With cho msg = "ChartObject '" & .name & "'" _ & ", type name: " & TypeName(cho) & ", at: " & .TopLeftCell.Address _ & ", index: " & ich & ", .Index: " & .Index _ & ", ZOrder: " & .ZOrder '& ", hyperlink: " & .Hyperlink End With Debug.Print msg Dim ish As Long ish = choidx2shpidx(ich, coc.Parent) Next ich End Sub Function choidx2shpidx(coidx As Long, ws As Worksheet) As Long Dim cozo As Long Dim coc As ChartObjects Dim co As ChartObject Set coc = ws.ChartObjects Set co = coc(coidx) cozo = co.ZOrder choidx2shpidx = zo2idx_shp(cozo, ws) Dim con As String, shn As String Dim sh As Shape Set sh = ws.Shapes(choidx2shpidx) con = co.name shn = sh.name Dim cox As Double, coy As Double Dim cow As Double, coh As Double Dim shx As Double, shy As Double Dim shw As Double, shh As Double cox = co.Left coy = co.top cow = co.Width coh = co.Height shx = sh.Left shy = sh.top shw = sh.Width shh = sh.Height If ((con <> shn) Or (cox <> shx) Or (coy <> shy) Or (cow <> shw) Or (coh <> shh)) Then Dim msg As String msg = "ChartObject: '" & con & "', Shape: '" & shn & "'" 'Debug.Print msg MsgBox msg choidx2shpidx = -1 End If End Function Function zo2idx_shp(zo As Long, ws As Worksheet) As Long Dim ish As Long Dim shc As Shapes Dim sh As Shape Set shc = ws.Shapes For ish = 1 To shc.Count Set sh = shc(ish) If (sh.ZOrderPosition = zo) Then zo2idx_shp = ish Exit Function End If Next ish zo2idx_shp = -1 End Function 

Answer 1

在类似的问题中失去了几个小时后，我发现了几个有关在Excel中引用形状的概念，但是没有一个能够让我满意。 为了访问一个形状，你有4个纯粹的方法：

1. Shape.Name ：快，但不可靠。 形状的名称可用于获取形状的引用，但前提是您没有重复的名称。 代码： ActiveSheet.Shapes("Shape1")

2. Shape.ZOrderPosition ：非常快，但不可靠。 形状的ZOrder可以用来获得形状的参考，因为它与形状集合中的形状的索引相同。 但是假设你没有一组破坏以前规则的形状 （参见： https ： //stackoverflow.com/a/19163848/2843348 ）。 代码： ActiveSheet.Shapes(ZOrderFromOneShape)

3. 设置shpRef =形状 ：快速，可靠，但不持久。 我总是尝试使用这个，特别是当我创build一个新的形状。 此外，如果我不得不在新的形状迭代后，我试图保持集合内的对象引用。 但不是持久的，这意味着如果你停下来再次运行你的VBA代码，将会丢失所有的引用和集合。 代码： Set shp = NewShape ，或者你可以将它添加到一个集合： coll.add NewShape for循环它以后。

4. Shape.ID ：可靠，持久，但不直接支持！ 形状的ID是非常可靠的（不要改变，不能在工作表中复制ID）。 但是，没有直接的VBA函数来获得一个形状知道它的ID。 唯一的方法是循环彻底的所有形状，直到ID匹配您正在寻找的ID，但这可以是非常慢！ 。

码：

 Function FindShapeByID(ws as excel.worksheet, ID as long) as Excel.Shape dim i as long set FindShapeByID = nothing 'Not found... for i = 1 to ws.shapes.count if ws.shapes(i).ID = ID then set FindShapeByID = ws.shapes(i) 'Return the shape object exit function end if next i End Function 

注1 ：如果要多次访问此函数，可以使用Shape ID的caching来改进它。 这样你只会做一次循环。
注意2 ：如果将一个形状从一张纸张移到另一张纸张， 形状的ID将会改变！

---

通过混合使用以上知识，我总结出两个主要的方法：

第一个方法

• 最快，但易挥发（与第3点相同）尽量保持对象的引用时间更长。 当我不得不迭代通过一堆形状后，我保存集合中的引用，我避免使用其他次要引用，如名称，ZOrder或ID。

例如：

 dim col as new Collection dim shp as Excel.Shape '' <- Insert the code here, where you create your shape or chart col.add shp1 '' <- Make other stuffs for each shp in col '' <- make something with the shape in this loop! next shp 

当然问题是收集和参考不是永久性的。 当您停止并重新启动vba代码时，您将丢失它们！

第二种方法

• PERSISTENT：我的解决scheme是保存形状的名称和ID以供日后参考。 为什么？ 有了这个名字，大部分时间我都可以非常快地进入这个形状。 以防万一我find了一个重复的名字，我让慢循环searchID。 我怎么知道是否有名字重复？ 很简单，只要检查名字search的ID，如果他们不匹配，你必须假设是重复的。

这里代码：

 Function findShapeByNameAndID(ws As Excel.Worksheet, name As String, ID As Long) As Shape Dim sh As Excel.Shape Set findShapeByNameAndID = Nothing 'Means not found On Error GoTo fastexit Set sh = ws.Shapes(name) 'Now check if the ID matches If sh.ID = ID Then 'Found! This should be the usual case! Set findShapeByNameAndID = sh Else 'Ups, not the right shape. We ha to make a loop! Dim i As Long For i = 1 To ws.Shapes.Count If ws.Shapes(i).ID = ID Then 'Found! This should be the usual case! Set findShapeByNameAndID = ws.Shapes(i) End If Next i End If fastexit: Set sh = Nothing End Function 

希望这可以帮助你！

---

注1：是否要search可能在组内的形状，然后function更复杂。

注2：ZOrder看起来不错，但是找不到它有用。 当我试图利用它，总是有一个缺失的部分…

Answer 2

@TimWilliams几乎是正确的（在他的评论中）。 但是，蒂姆的想法可能会导致混乱的结果。

我认为下面的代码会更合适和正确。

 Sub qTest() Dim cho As ChartObject Set cho = ActiveSheet.ChartObjects(1) Dim SH As Shape Set SH = cho.ShapeRange.Item(1) SH.Select 'here Shape will be selected.. Debug.Print TypeName(SH) '...which we can check here End Sub