Excel VBA：如何从ChartObject获取对Shape的引用 [英] Excel VBA: How to obtain a reference to a Shape from the ChartObject
问题描述
我正在尝试获得工作表中的 Shape 的引用，对应于 ChartObject 。我没有发现任何这样做的方式。在几种情况下，通过反复试验和简单测试，唯一的近似是假设一个 ChartObject ZOrder c>与相应的 Shape的索引相同：
I am trying to obtain a reference to a Shape in a Worksheet, corresponding to a ChartObject. I found no certain way of doing this. The only approximation, by trial-and-error and simply tested in a few cases, is assuming that the ZOrder of a ChartObject is the same as the Index of the corresponding Shape:
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
（稍微超出定义的变量用于调试目的）。
(a slight excess of defined variables is used for debugging purposes).
有没有更多的确定方法？
任何用于pickin的标识符g正确的 Shape 应该是唯一的。该名称不一定是唯一的（请参阅 https://stackoverflow.com/questions/19153331/duplicated-excel-chart-has-the-same-name-name-as-the-original-instead-of-increm ），所以它不能保证工作。 索引 / ZOrderPosition 只是一个猜测，至少满足唯一性的要求。
Any identifier used for picking the correct Shape should be unique. The name is not necessarily unique (see https://stackoverflow.com/questions/19153331/duplicated-excel-chart-has-the-same-name-name-as-the-original-instead-of-increm), so it is not guaranteed to work. The Index/ZOrderPosition is just a guess, at least satisfying the requirement of uniqueness.
修改：请参阅@Andres在 Excel VBA：Index = ZOrderPosition in Shapes集合。很明显， ChartObject 的 ZOrder 不等于索引（$ code）ChartObject 或相应的 Shape （我已经验证过）。
但是似乎 ZOrder 等于相应的 Shape ZOrderPosition / code>。这是通过 dump_chartobjects 验证的：
Edit: see answer by @Andres in Excel VBA: Index = ZOrderPosition in a Shapes collection?. It is clear that the ZOrder of a ChartObject is not equal to the Index of either the ChartObject or the corresponding Shape (and I have verified this).
But it appears that ZOrder is equal to ZOrderPosition of the corresponding Shape. This was verified with dump_chartobjects:
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
推荐答案
在类似的问题中丢了几个小时后，我发现了几个有关引用excel中的形状的概念，但是没有人满足于100％。对于访问形状，您有4种纯粹的方法：
After losing hours in a similar issue, I found a couple of concepts related to referencing shapes in excel, but none satisfies me 100%. For accessing a shape you have 4 pure methods:
-
Shape.Name ：是FAST，但是不可靠的。形状的名称可以用于获取形状的引用，但是如果没有重复的名称。代码：
ActiveSheet.Shapes（Shape1）
Shape.Name : Is FAST, but NOT RELIABLE. The name of the shape could be used to get a reference of a shape but provided you don't have duplicated names. Code:
ActiveSheet.Shapes("Shape1")
Shape.ZOrderPosition ：很快，但不可靠。形状的ZOrder可用于获取形状的引用，因为它与形状集合中形状的索引相同。但是，如果您没有打破以前规则的形状组（请参阅： https：// stackoverflow。 COM /一个/二百八十四万三千三百四十八分之一千九百十六万三千八百四十八）。代码： ActiveSheet.Shapes（ZOrderFromOneShape）
Shape.ZOrderPosition : Very FAST, but NOT RELIABLE. The ZOrder of the shape could be used to get a reference of a shape, because is the same as the index of the shape in the shapes collection. But provided you don't have group of shapes that breaks previous rule (See: https://stackoverflow.com/a/19163848/2843348). Code: ActiveSheet.Shapes(ZOrderFromOneShape)
设置shpRef = Shape ：快速，可靠，但不要求。我尽量使用这个，我可以，特别是当我创建一个新的形状。而且，如果稍后我必须迭代新的形状，我尝试将对象引用保存在一个集合中。但是不要持久化，这意味着如果您再次停止并运行VBA代码，将会丢失所有的引用和集合。代码：设置shp = NewShape ，或者您可以将其添加到集合中： coll.add NewShape for循环
Set shpRef=Shape: FAST, RELIABLE, but NOT PERSISTENT. I try to use this always I can, specially when I create a new shape. Moreover, if I have to iterate on the new shapes later one I try to keep the object reference inside a collection. However not Persistent, that means if you stop and run you VBA code again to will loose all the references and collection. Code: Set shp = NewShape, or you can add it to a collection: coll.add NewShape for loop it later on.
Shape.ID ：可靠，不间断，但不直接支持！形状的ID非常可靠（不要更改，不能在Sheet中重复ID）。然而，没有直接的VBA功能来获得形状了解其ID。唯一的方法是循环遍历所有形状，直到ID与您要查找的ID相符，但这可能非常 SLOW！。
Shape.ID : RELIABLE, PERSISTENT, but not directly supported! The ID of the shape is very reliable (don't change and cannot be duplicates IDs in a Sheet). However, there is no direct VBA function to get a shape back knowing its ID. The only way is to loop thorough all shapes until the ID match the ID you was looking for, but this can be very SLOW!.
代码：
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缓存来改进它。这样一来，您只能循环一次。
注2：如果您将形状从一张纸移动到另一张，形状的ID将会更改！
Note 1: If you want to access this function several times, you can improve it by using a cache of Shape IDs. That way you will make the loop only one time.
Note 2: If you move a shape from one sheet to other, the ID of the shape will change!
通过混合使用上述知识，我总结了两种主要方法：
By mixing and using above knowledge, I have concluded in two main approaches:
- 最快但不可变的:(与＃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代码时松开它们。
The problem of course is that the collection and reference are not permanent. You will loose them when you stop and restart the vba code!
- PERSISTENT：我的解决方案是保存形状的名称和 ID ，供以后参考。为什么？名字我可以大部分时间访问形状非常快。为了防止我发现重复的名称，我会慢慢搜索ID。如何知道是否有重复的名称？很简单，只需检查名字搜索的ID，如果不匹配，你必须假设是重复的。
- PERSISTENT: My solution is to save the name and the ID of the shape for later reference. Why? Having the name I can access the shape very fast most of the time. Just in case I found a duplicated name I make the slow loop searching the ID. How can I know if there is a name duplicated? Very simple, just check the ID of the first name search, and if they don't match you have to suppose is duplicated.
这里代码：
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：是否要搜索组内的形状，然后功能更复杂。
Note 1: Is you want to search shapes that maybe inside groups, then the function is more complicated.
注2： ZOrder看起来不错，但找不到它有用。当我试图利用它，总是有一个缺失的部分...
Note 2: The ZOrder looks nice, but cannot find it useful. When I tried to take advantage of it, there was always a missing part...
这篇关于Excel VBA：如何从ChartObject获取对Shape的引用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
