含数据验证下拉框的工作表中，如何获取新粘贴图形的引用？

要获取刚粘贴的Shape引用，最可靠的通用方法是粘贴前记录所有已有Shape的唯一标识（ID），粘贴后对比找出新增的那个。因为数据验证的下拉Shape会占用最后索引位，直接取Shapes.Count无效，而Shape的ID是唯一且不会重复的，能精准定位新增对象。

实现代码 #

Option Explicit

Private Sub Worksheet_Calculate()
    Dim rng As Range
    Dim sh As Worksheet
    Dim shp As Shape
    Dim existingShapeIDs As Collection
    Dim newShp As Shape
    Dim shpID As String
    
    Set sh = ThisWorkbook.Worksheets("Sheet2")
    Set existingShapeIDs = New Collection
    
    ' 记录粘贴前所有Shape的ID（用ID作为唯一标识）
    On Error Resume Next ' 忽略重复键错误（ShapeID不会重复，仅作兜底）
    For Each shp In sh.Shapes
        shpID = CStr(shp.ID)
        existingShapeIDs.Add shpID, Key:=shpID
    Next shp
    On Error GoTo 0
    
    ' 复制并粘贴图片
    Set rng = sh.Range("C10:C11")
    rng.CopyPicture
    sh.Paste
    
    ' 遍历找到新增的Shape
    For Each shp In sh.Shapes
        shpID = CStr(shp.ID)
        On Error Resume Next
        existingShapeIDs.Item(shpID)
        ' 如果ID不在之前的集合中，说明是新粘贴的
        If Err.Number <> 0 Then
            Set newShp = shp
            Exit For
        End If
        On Error GoTo 0
    Next shp
    
    ' 操作新粘贴的Shape（示例）
    If Not newShp Is Nothing Then
        ' 比如设置位置、名称或格式
        newShp.Name = "Pasted_Range_Image"
        newShp.Top = sh.Range("G10").Top
        newShp.Left = sh.Range("G10").Left
    End If
End Sub

代码说明 #

1. 记录已有Shape：粘贴前遍历工作表所有Shape，将它们的ID存入集合，ID是Excel为每个Shape分配的唯一不变标识，不会重复。
2. 对比找新增Shape：粘贴后再次遍历，检查每个Shape的ID是否在之前的集合中——不在的就是刚粘贴的对象。
3. 通用适配：这个方法不受工作表中已有Shape的数量、类型（包括数据验证下拉框）影响，完全通用。

内容的提问来源于stack exchange，提问作者Anton Lahti