下面是一个示例代码,用于比较从Selection中检索到的形状对象和从ActiveSheet.Shapes集合中检索到的相同形状:
Sub CompareShapes()
Dim selShape As Shape
Dim shapesColl As Shapes
Dim foundShape As Shape
' 获取Selection中的形状对象
Set selShape = Selection.ShapeRange(1)
' 获取ActiveSheet中的所有形状对象
Set shapesColl = ActiveSheet.Shapes
' 在Shapes集合中查找与Selection中的形状对象相同的形状
For Each foundShape In shapesColl
If CompareTwoShapes(selShape, foundShape) Then
MsgBox "找到相同的形状:" & foundShape.Name
Exit Sub
End If
Next foundShape
MsgBox "未找到相同的形状"
End Sub
Function CompareTwoShapes(shape1 As Shape, shape2 As Shape) As Boolean
' 比较两个形状对象的属性是否相同
If shape1.Type = shape2.Type And shape1.Left = shape2.Left And shape1.Top = shape2.Top And shape1.Width = shape2.Width And shape1.Height = shape2.Height Then
CompareTwoShapes = True
Else
CompareTwoShapes = False
End If
End Function
此代码首先从Selection中获取一个形状对象,然后从ActiveSheet.Shapes集合中获取所有形状对象。然后,它使用CompareTwoShapes函数来比较从Selection中检索到的形状对象和从ActiveSheet.Shapes集合中检索到的每个形状对象。如果找到相同的形状,它将显示一个消息框。如果未找到相同的形状,它将显示另一个消息框。