Home » excel » excel – Determine shape position with cell

excel – Determine shape position with cell

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have an Excel calendar in which certain cells have a shape on them. I wish to be able to see which cells have a shape and then be able to extract some data.
I’ve searched a bit and found that the best option was to use TopLeftCell.Row but it seems there’s an error on my code. I’ve copied a code and tried to adapt it, here it is:

Sub ActiveShapeMacro()

Dim ActiveShape As Shape
Dim UserSelection As Variant

'Pull-in what is selected on screen
  Set UserSelection = ActiveWindow.Selection

'Determine if selection is a shape
  On Error GoTo NoShapeSelected
    Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
  On Error Resume Next

'Do Something with your Shape variable
  Cells(Sheet1.Shapes(ActiveShape).TopLeftCell.Row, Sheet1.Shapes(ActiveShape).TopLeftCell.Column).Address
  MsgBox (ActiveShape.Address)

Exit Sub

'Error Handler
NoShapeSelected:
  MsgBox "You do not have a shape selected!"


End Sub

Thank you for your help! 🙂

How to&Answers:

the error is in:

Sheet1.Shapes(ActiveShape)

where Shapes is waiting for a string (the shape name) while you’re providing an Object (the shape itself)

so use:

'Do Something with your Shape variable
  MsgBox Cells(ActiveShape.TopLeftCell.Row, ActiveShape.TopLeftCell.Column).Address

that can be simplified to:

   MsgBox ActiveShape.TopLeftCell.Address

Moreover change:

On Error Resume Next 

to:

On Error GoTo 0

and keep watching what’s happening in there…

Answer:

Here is an easy way to determine if a range or Shape has been selected and if it is a Shape, where it is:

Sub skjdkffdg()
    Dim s As Shape, typ As String

    typ = TypeName(Selection)

    If typ = "Range" Then
        MsgBox " you have a range selected: " & Selection.Address
    Else
        Set s = ActiveSheet.Shapes(Selection.Name)
        MsgBox "you have a Shape selected: " & s.TopLeftCell.Address
    End If
End Sub

This assumes that the only things on the worksheet are Shapes and Ranges.