Does a shape cover a cell ?

[Gary''s Student]

I need a simple boolean function that, give the name of a shape and the
address of a single cell, will return TRUE if the cell is fully or partially
covered by the shape. Otherwise FALSE.

Thanks in advance

 

[Jim Cone]

GS,
A Shape has TopLeftCell and BottomRightCell properties.
Those two will give you the range it is over.
Application.Intersect should then answer your question.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Gary''s Student"
wrote in message
I need a simple boolean function that, give the name of a shape and the
address of a single cell, will return TRUE if the cell is fully or partially
covered by the shape. Otherwise FALSE.

Thanks in advance

 

[Bernie Deitrick]

Gary's Student,

Function Cover(strShapeName As String, cAdd As String) As Variant
On Error GoTo ErrHandler
With Range(cAdd).Parent.Shapes(strShapeName)
Cover = Not Intersect(Range(cAdd), Range(.TopLeftCell, .BottomRightCell)) Is Nothing
End With
Exit Function
ErrHandler:
Cover = "Bad :-("
End Function


Sub TestTheFunction()
MsgBox Cover("Rectangle 1", "C4")
End Sub

 

[Bernie Deitrick]

I should also have noted that if you want to find out if the shape _Visually_ covers part of a cell,
you are out of luck - the drawing object is rectangular, even if visually it is a line, or curve or
something else.

HTH,
Bernie
MS Excel MVP

 

[Gary''s Student]

Thanks...this gives me something to work with.

 

[Gary''s Student]

Thanks !!
--
Gary''s Student - gsnu200764

Gary's Student,

Function Cover(strShapeName As String, cAdd As String) As Variant
On Error GoTo ErrHandler
With Range(cAdd).Parent.Shapes(strShapeName)
Cover = Not Intersect(Range(cAdd), Range(.TopLeftCell, .BottomRightCell)) Is Nothing
End With
Exit Function
ErrHandler:
Cover = "Bad :-("
End Function


Sub TestTheFunction()
MsgBox Cover("Rectangle 1", "C4")
End Sub

 

[Joel]

There is no simple way of doing this. You have to get the Top, Left, Width,
and Length of both the cell and shape to determine if there is an overlap

Because the shape and cell are both rectangle you need to test all four
corners of the shape against al four sides of the cell to determine a partial
overlap

for the top left corner of the shape it would be something like this

'four corners of the shape
sxleft = shape.left
sytop = shape.top
sxright = sxleft + shape.width
sxbottom = sytop + shape.height

'four corners of the cell
cxleft = shape.left
cytop = shape.top
cxright = cxleft + shape.width
cxbottom = cytop + shape.height

if (sxleft >= cxleft) and sxleft <= cxright) and
(sxtop >= cxtop) and sxtop <= cxbottom) then

overlap is true
end if

now repeat for other three conditions of. Instead of sxleft and sxtop use
sxright and sxtop
sxleft and sxbotom
sxright and sxbotom

Only one of the 4 conditions needs to be met to determine overlap.

 

[Peter T]

Function bCovers(obj As Object, rng As Range) As Boolean
With obj
If .Left <= rng.Left Then
If .Top <= rng.Top Then
If .Left + .Width >= rng.Left + rng.Width Then
bCovers = .Top + .Height >= rng.Top + rng.Height
End If
End If
End If
End With
End Function

obj as Object to cater for any drawingobject type, eg simply Selection, or
if a Shape, but change to As Shape if you prefer.

Regards,
Peter T

 

[Peter T]

I read "fully covered" but misread "or partially".
The function I posted returns true for "fully covers" only, but I see others
have posted enough for you.

Regards,
Peter T

 

[Gary''s Student]

Thanks !
--
Gary''s Student - gsnu200764

There is no simple way of doing this. You have to get the Top, Left, Width,
and Length of both the cell and shape to determine if there is an overlap

Because the shape and cell are both rectangle you need to test all four
corners of the shape against al four sides of the cell to determine a partial
overlap

for the top left corner of the shape it would be something like this

'four corners of the shape
sxleft = shape.left
sytop = shape.top
sxright = sxleft + shape.width
sxbottom = sytop + shape.height

'four corners of the cell
cxleft = shape.left
cytop = shape.top
cxright = cxleft + shape.width
cxbottom = cytop + shape.height

if (sxleft >= cxleft) and sxleft <= cxright) and
(sxtop >= cxtop) and sxtop <= cxbottom) then

overlap is true
end if

now repeat for other three conditions of. Instead of sxleft and sxtop use
sxright and sxtop
sxleft and sxbotom
sxright and sxbotom

Only one of the 4 conditions needs to be met to determine overlap.

 

[Gary''s Student]

Thank you. Your response and the others have given me enough insight to get
where I needed to go:

If graphics obscure important cells, move the graphics to the right.