Select the cell behind a shape

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
3,194
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi everyone,
I would like to have a macro that when I click on any shape in sheet "Data1" it select the cell Behind it,
The page is set in such a way that every picture is within a single cell.

Please help if you can

Thanks

Tony
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Assign to each figure the macro "Sel_Cell"

Code:
Sub Sel_Cell()
    Dim wCell As Range, v As Variant
    
    v = Application.Caller
    wtop = ActiveSheet.Shapes(v).Top
    For Each wCell In ActiveSheet.Range("A1", ActiveSheet.UsedRange.SpecialCells(11).Address)
        If Not Intersect(ActiveSheet.Shapes(v).TopLeftCell, wCell) Is Nothing And _
           Not Intersect(ActiveSheet.Shapes(v).BottomRightCell, wCell) Is Nothing Then
            wCell.Select
            Exit Sub
        End If
    Next
    MsgBox "The image is not within a single cell"
End Sub
 
Upvote 0
Assuming the point is not to validate the sheet design, why not just ...

Code:
Sub Sel_Cell()
  ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
End Sub
 
Upvote 0
If you know that the shape will always be in that cell, no problem. But if you're asking for code to determine which cell the shape is in so you can select the cell, much harder.

This is some simple code I just created. I inserted a picture and made the corners attach to the cell corners of C2. Because the picture corners don't exactly match the cell corners, you have to fudge a little. Both of those subs were in the same standard module.


Code:
Sub Picture999_click()
  Dim Shp As Shape
  Set Shp = ActiveSheet.Shapes("Picture999")
  Call SelectCellByShape(Shp)
End Sub




Sub SelectCellByShape(Shp As Shape)
  Dim Cel As Range
  Dim L As Single
  Dim T As Single
  Dim PL As Single
  Dim PT As Single
  Dim Sht As Worksheet
  Dim C As Long
  Dim R As Long
  Dim Col As Long
  Dim Rw As Long
  
  Set Sht = ActiveSheet
  PL = Shp.Left
  PT = Shp.Top
  
  With Sht
    For Each Cel In .Range(.Cells(1, 1), .Cells(1, .Columns.Count))
      If Abs(Cel.Left - PL) < 0.001 Then
        Col = Cel.Column
        Exit For
      End If
    Next Cel
    
    For Each Cel In .Range(.Cells(1, 1), .Cells(.Rows.Count, 1))
      If Abs(Cel.Top - PT) < 0.001 Then
        Rw = Cel.Row
        Exit For
      End If
    Next Cel
  End With
  
  Sht.Cells(Rw, Col).Select
  
End Sub
 
Upvote 0
Assuming the point is not to validate the sheet design, why not just ...

Code:
Sub Sel_Cell()
  ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
End Sub

Awesome!
 
Last edited:
Upvote 0
Thanks to all of you for your help,
they all worked great so I don't know who to thank the most so thank you to all of you.
Hope that's OK?
this was abig help
Thanks
Tony
 
Upvote 0
I'm glad to help you. I appreciate your kind comments.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top