6

我试图在 a 中获取对 a 的引用ShapeWorksheet对应于 a ChartObject。我发现没有确定的方法可以做到这一点。通过反复试验并在少数情况下简单测试的唯一近似值是假设ZOrderaChartObject的 与对应的 Index 相同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

(稍微过量的定义变量用于调试目的)。

有没有更确定的方法来做到这一点?

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

编辑:在Excel VBA 中查看@Andres 的回答:Shapes 集合中的 Index = ZOrderPosition?. 很明显ZOrdera 的 aChartObject不等于IndextheChartObject或对应的 the Shape(我已经验证了这一点)。但它似乎ZOrder等于ZOrderPosition对应的Shape。这已通过以下方式验证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
4

2 回答 2

9

在一个类似的问题上浪费了几个小时后,我发现了一些与在 excel 中引用形状相关的概念,但没有一个能让我 100% 满意。要访问形状,您有 4 种纯方法:

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

  2. Shape.ZOrderPosition:非常快,但不可靠。形状的 ZOrder 可用于获取形状的引用,因为它与形状集合中的形状索引相同。但前提是您没有违反先前规则的形状组(请参阅: https ://stackoverflow.com/a/19163848/2843348 )。代码:ActiveSheet.Shapes(ZOrderFromOneShape)

  3. 设置 shpRef=Shape:快速、可靠,但不持久。我总是尽可能地使用它,特别是当我创建一个新形状时。此外,如果以后必须对新形状进行迭代,我会尝试将对象引用保留在集合中。但是不是持久的,这意味着如果您停止并再次运行您的 VBA 代码将丢失所有引用和集合。代码: Set shp = NewShape,或者您可以将其添加到集合中:coll.add NewShapefor 稍后循环它。

  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 IDs的缓存来改进它。这样,您将只循环一次。
注意 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 代码时,您将丢失它们!

第二种方法

  • 持久性:我的解决方案是保存形状的名称ID以供以后参考。为什么?有了这个名字,我大部分时间都可以非常快速地访问形状。以防万一我发现重复的名称,我会慢速循环搜索 ID。我怎么知道是否有重复的名字?很简单,只要检查名字搜索的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:如果你想搜索可能在组内的形状,那么功能会更复杂。

注意 2:ZOrder 看起来不错,但没有发现它有用。当我试图利用它时,总是有一个缺失的部分......

于 2013-10-04T23:43:43.097 回答
-1

@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
于 2013-10-02T21:01:02.963 回答