How do I determine the endpoints of a line drawing object?
I have a line drawing object (= autoshape) in an Excel spreadsheet. I want to determine which cell it "points to". To do this, I need to know the coordinates of the start and end points.
I can use .Top
, .Left
, .Width
, .Height
to determine the bounding box, but the line can be in two different positions in the box.
source to share
To do this, you must use the HorizontalFlip
and elements VerticalFlip
. The following function should do what you want:
Function CellFromArrow(ByVal s As Shape) As Range
Dim hFlip As Integer
Dim vFlip As Integer
hFlip = s.HorizontalFlip
vFlip = s.VerticalFlip
Select Case CStr(hFlip) & CStr(vFlip)
Case "00"
Set CellFromArrow = s.BottomRightCell
Case "0-1"
Set CellFromArrow = Cells(s.TopLeftCell.Row, s.BottomRightCell.Column)
Case "-10"
Set CellFromArrow = Cells(s.BottomRightCell.Row, s.TopLeftCell.Column)
Case "-1-1"
Set CellFromArrow = s.TopLeftCell
End Select
End Function
This code has been tested in Excel 2010. Seems to work. Hope this helps!
EDIT: If you have to worry about the shapes contained in groups, then it seems like the only solution is to ungroup, iterate over the shapes and then regroup. Something like the following:
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = msoGroup Then
Dim oldName as String
Dim sGroup As GroupShapes
Dim GroupMember as Shape
Set sGroup = s.GroupItems
oldName = s.Name 'To preserve the group Name
s.Ungroup
For Each GroupMember in sGroup
'DO STUFF
Next
Set s = sGroup.Range(1).Regroup 'We only need to select one shape
s.Name = oldName 'Rename it to what it used to be
End If
Next
You can refer to the ShapeRange Documentation for more information on the "Regroup" method.
Let me know if this works for you!
source to share