how to find shape immediately behind the active shape

how to find shape immediately behind the active shape

  • hold alt key as you select to "dig" down 

    • Not manually, but by codes

      • My crude attempt

        Sub SelectShapeBehind()
        Dim sr As ShapeRange
        Optimization = True
        Set sr = ActiveSelectionRange
        sr.RemoveFromSelection
        sr.Shapes.Last.AddToSelection
        sr.Shapes.Last.Next.AddToSelection
        sr.Shapes.Last.RemoveFromSelection
        Optimization = False
        ActiveWindow.Refresh
        Application.Refresh
        End Sub