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

1 answer

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
        For Each GroupMember in sGroup
            'DO STUFF
        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


You can refer to the ShapeRange Documentation for more information on the "Regroup" method.

Let me know if this works for you!



All Articles