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
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
. 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