Sorry there, I replied directly but found out this got rejected.
So here is the original reply - better late than never :)


Thanks for your comments cool.
I posted to Newsgroups: microsoft.public.excel.programming
I deleted the original message and put in a new subject. I'm not sure what else to do if one wanted to post a question. I didn't
see any trace of the old subject in my post nor in your reply.

Ah, I see I could have just used New Message, something I've never done.
I'm just in the habit of replying by right click, and choosing Reply to Sender or Group.

As for your code, this is interesting.
It does something similar I was already doing, but as it loops through all shapes on the sheet, I was hoping to avoid a situation
where one has selected a range of several cells and there are 1,000's of shapes. This is what I currently have to add and delete
shapes.


Sub AddshapeShort()
'The long version has error handling
'and one more important line
Dim Obj As Shape, sh As Worksheet, MyShape As Shape
Dim Rng As Range, c As Range, x As Integer, w As Integer
Set Rng = Selection: Set sh = ActiveSheet
For Each c In Rng.Cells
x = Int(Rnd() * 80 + 1)
With c
w = Application.Min(.Width, .Height) * 0.8
Set MyShape = sh.Shapes.AddShape(92, .Left + _
(.Width - w) / 2, .Top + (.Height - w) / 2, w, w)
MyShape.Fill.ForeColor.SchemeColor = x
End With
Next c
End Sub

Sub DelObjInRangeOldWay()
Dim Obj As Shape, sh As Worksheet
Dim Rng As Range: Set Rng = Selection
Set sh = ActiveSheet
For Each Obj In sh.Shapes
If Not Intersect(Rng, Obj.BottomRightCell) _
Is Nothing Then Obj.Delete
Next Obj
End Sub


Since I have posted I have discovered a way to do what I originally posted, which is to loop through a selection and delete any
shape within. As it only loops the cells and not the shapes it is fairly quick.


Regards
Robert McCurdy

----- Original Message -----
From: "keepITcool"
Newsgroups: microsoft.public.excel.programming
Sent: Wednesday, July 21, 2004 5:26 AM
Subject: Cell shape connect - is there one?


Robert..


I think you were posting in the wrong thread...
but never mind..

This will do.. not ultra fast but does the trick :)
returns a collection of the (Shapes and the Range it covers)
for a particular area.

Function ShapeCover(rngToSearch As Range) As Collection
Dim rngCovered As Range, sh As Shape

Set ShapeCover = New Collection
For Each sh In ActiveSheet.Shapes
Set rngCovered = Range(sh.TopLeftCell, sh.BottomRightCell)
If Not Intersect(rngToSearch, rngCovered) Is Nothing Then
ShapeCover.Add Array(sh, rngCovered), sh.Name
End If

Next

End Function

Sub foo()
Dim x As Collection
Set x = ShapeCover([B3:G100])
Stop
End Sub

--
keepITcool

| www.XLsupport.com | keepITcool chello nl | amsterdam


Robert McCurdy wrote :

Hi all.

I know you can use the shapes properties to figure out what cell it
covers, but does any one know if the reverse is possible.

Selecting a range and via code get a true/false for "Is there a shape
intersect here?" for each cell?

I believe with normal VBA there isn't, and I'm not interested in any
C++ or API calls, just what is available within VBA.


Regards
Robert McCurdy






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.725 / Virus Database: 480 - Release Date: 19/07/2004