0

I'm trying to check if the Shape selected by user is the proper one. For the simplicity, let's say we have only one shape in otherwise empty worksheet. Because of that, we know that the selected shape must be the right one:

Sub AreShapesTheSame()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim shape As Object
    Dim selShape As Object

    Set shape = ws.Shapes.Item(1).DrawingObject
    Set selShape = Selection

    MsgBox shape Is selShape

End Sub

I can see in the Locals window, that the objects shape and selShape have the same attributes. Also if I change the name of one of them (shape.name = "xxx"), the name of the other object also changes. So I presume, that they are the same objects, or at least referencing the same object.

If that is the case, why is the statement (shape Is selShape) returning False? How can I check if the user Selection is referencing some specific Object?

braX
  • 11,506
  • 5
  • 20
  • 33
Tomasz
  • 11
  • 2
  • What about `MsgBox shape.Name = selShape.Name`? This will probably error depending on what is selected. – SJR Feb 07 '20 at 16:36
  • Test `MsgBox TypeName(Shapes) & " versus " & TypeName(selShape)`... – Chronocidal Feb 07 '20 at 17:09
  • 1
    @SJR That generally works as basic comparison, but It's not guaranteed that all the Shape objects in my worksheet will have different names. So I cannot depend on this approach. Eventually, I plan to write a function that will be comparing more attributes, like .name, .height, .width, etc., but I'd like it to be last resort solution. – Tomasz Feb 07 '20 at 19:41
  • @Chronocidal Depending on what type of Shape is being selected, it may be 'Rectangle', 'Picture', etc. Either way, TypeName(Shape) and TypeName(selShape) are equal. – Tomasz Feb 07 '20 at 19:45
  • Well you need some way of distinguishing them so if not the name some other property. There has to be something unique. – SJR Feb 07 '20 at 20:58
  • Maybe topleftcell? – SJR Feb 07 '20 at 20:59

1 Answers1

0

If you change Selection to shape you get your True in the message box. This means we need a way to tell the macro the real reference we need for comparing. I don't know how the users select a shape but I think it's a simple click.

If so, you can proceed as follows. Assign the following macro to each shape for comparison. You can make the assignment using the onAction property of the shapes with a separate macro for all shapes in a loop over the shapes collection.

Place two shapes to test and assign the macro to each shape. In the example, you must specify the index for the expected shape in an input field. In your project the index comes in another way.

Sub AreShapesTheSame()

  Dim shape As Object
  Dim selShape As Object
  Dim shapeIndexToCompareWithClickedOne As Long

  shapeIndexToCompareWithClickedOne = InputBox("ShapeIndex", "Insert shape index")
  Set shape = ActiveSheet.Shapes.Item(shapeIndexToCompareWithClickedOne)
  Set selShape = ActiveSheet.Shapes.Item(Application.Caller)

  MsgBox shape Is selShape
End Sub
Zwenn
  • 2,147
  • 2
  • 8
  • 14
  • Thx Zwenn. Shape.OnAction() was my "weapon of choice" at first, but I couldn't use it, because of how the .OnAction() changes default behavior of Shapes (different mouse cursor, impossible resize, translations, etc.). This approach might be helpful, but unfortunately not in my particular case. --- Generally speaking, my macro shows an UserForm (vbModeless) with some controls. Then, whenever the Selection on Worksheet changes, I want to chceck which among the Shapes has being selected. – Tomasz Feb 10 '20 at 15:24
  • I think I found a workaround to compare Shape objects from ActiveSheet.Shapes collection and Shape object retrieved from Selection. Since the Shapes are always (at leas I presume that is the case) stacked one on another like layers, and it's impossible for two Shapes to populate the same layer, it is enough to check if two Shape objects have the same .ZOrder or .ZOrderPosition property. If this property is equal for two Objects, they must be referencing the same Shape on given Worksheet. – Tomasz Feb 10 '20 at 16:02