Select the cell behind a shape

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,575
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
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
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
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,768
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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:

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,575
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. I appreciate your kind comments.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,545
Messages
5,529,458
Members
409,879
Latest member
Aussie_Excel_Wanna_Be
Top