RangeFromPoint Only Finds ShapesAt 0, 0 coordinates

[Guest]

I am trying to use the RangeFromPoint(.PointsToScreenPixelsX(ActiveCell.Left), PointstoScreenPixelsY(ActiveCell.Top) to see if a Shape is already positioned over a cell so that if a shape is there I can delete it before pasting a new shape in its place. The RangeFromPoint command only returns the correct result if the shape is positioned at cell A1, otherwise it does not work. Any ideas?

 

[Tushar Mehta]

What do you mean by "correct result?" If you check the documentation,
it indicates that the correct result is 'nothing' if there is no shape
at that coordinate.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Tom Ogilvy]

dim rng1 as Range, rng2 as Range
dim shp as Shape
set rng2 = Range("B9") ' cell of interest
for each shp in ActiveSheet.Shapes
set rng1 = Range(shp.topLeftCell, shp.BottomRightCell)
if not intersect(rng1,rng2) is nothing then
shp.Delete
end if
Next

--
Regards,
Tom Ogilvy

I am trying to use the

RangeFromPoint(.PointsToScreenPixelsX(ActiveCell.Left),
PointstoScreenPixelsY(ActiveCell.Top) to see if a Shape is already
positioned over a cell so that if a shape is there I can delete it before
pasting a new shape in its place. The RangeFromPoint command only returns
the correct result if the shape is positioned at cell A1, otherwise it does
not work. Any ideas?

 

[Guest]

What I mean by "correct" result is that the return value of RangeFromPoint is not "Nothing" even though a Shape was not found. Instead the return value is a Range which address is nowhere near the address of the shape that I am trying to delete

Here is the code

Sub A(

Dim CellPointsX As Long, CellPointsY As Long, CellPixelsX As Long, CellPixelsY As Long,
ScrollRowPoints As Long, ScrollColPoints As Long, ScrollPixelsX As Long, ScrollPixelsY As Long,
WndPointsX As Long, WndPointsY As Long, WndPixelsX As Long, WndPixelsY As Long,
AppPointsX As Long, AppPointsY As Long, AppPixelsX As Long, AppPixelsY As Long,
Result As Variant, ResultPixelsX As Long, ResultPixelsY As Long, AllShapes As ShapeRang

With ActiveWindo
CellPointsX = ActiveCell.Lef
CellPointsY = ActiveCell.To
CellPixelsX = .PointsToScreenPixelsX(CellPointsX
CellPixelsY = .PointsToScreenPixelsY(CellPointsY
WndPointsX = .Lef
WndPointsY = .To
WndPixelsX = .PointsToScreenPixelsX(WndPointsX
WndPixelsY = .PointsToScreenPixelsY(WndPointsY
ScrollColPoints = ActiveSheet.Cells(.ScrollRow, .ScrollColumn).Lef
ScrollRowPoints = ActiveSheet.Cells(.ScrollRow, .ScrollColumn).To
ScrollPixelsX = .PointsToScreenPixelsX(ScrollColPoints
ScrollPixelsY = .PointsToScreenPixelsY(ScrollRowPoints
AppPointsX = Application.Lef
AppPointsY = Application.To
AppPixelsX = .PointsToScreenPixelsX(Application.Left
AppPixelsY = .PointsToScreenPixelsY(Application.Top
Set Result = .RangeFromPoint(x:=CellPixelsX, y:=CellPixelsY
End Wit

If Result Is Nothing The
MsgBox "Result Is Nothing." & Chr(13)
& "CellPointsX = " & Str(CellPointsX) & " CellPointsY = " & Str(CellPointsY) & Chr(13)
& "CellPixelsX = " & Str(CellPixelsX) & " CellPixelsY = " & Str(CellPixelsY) & Chr(13)
& "WndPointsX = " & Str(WndPointsX) & " WndPointsY = " & Str(WndPointsY) & Chr(13)
& "WndPixelsX = " & Str(WndPixelsX) & " WndPixelsY = " & Str(WndPixelsY) & Chr(13)
& "AppPointsX = " & Str(AppPointsX) & " AppPointsY = " & Str(AppPointsY) & Chr(13)
& "AppPixelsX = " & Str(AppPixelsX) & " AppPixelsY = " & Str(AppPixelsY) & Chr(13)
& "ScrollColPoints = " & Str(ScrollColPoints) & " ScrollRowPoints = " & Str(ScrollRowPoints) & Chr(13)
& "ScrollPixelsX = " & Str(ScrollPixelsX) & " ScrollPixelsY = " & Str(ScrollPixelsY
Els
If TypeName(Result) = "Range" The
Result.Selec
ResultPixelsX = ActiveWindow.PointsToScreenPixelsX(Result.Left
ResultPixelsY = ActiveWindow.PointsToScreenPixelsY(Result.Top
MsgBox "Result.Address = " & Result.Address & Chr(13)
& "ResultPointsX = " & Str(Result.Left) & " ResultPointsY = " & Str(Result.Top) & Chr(13)
& "ResultPixelsX = " & Str(ResultPixelsX) & " ResultPixelsY = " & Str(ResultPixelsY) & Chr(13)
& "CellPointsX = " & Str(CellPointsX) & " CellPointsY = " & Str(CellPointsY) & Chr(13)
& "CellPixelsX = " & Str(CellPixelsX) & " CellPixelsY = " & Str(CellPixelsY) & Chr(13)
& "WndPointsX = " & Str(WndPointsX) & " WndPointsY = " & Str(WndPointsY) & Chr(13)
& "WndPixelsX = " & Str(WndPixelsX) & " WndPixelsY = " & Str(WndPixelsY) & Chr(13)
& "AppPointsX = " & Str(AppPointsX) & " AppPointsY = " & Str(AppPointsY) & Chr(13)
& "AppPixelsX = " & Str(AppPixelsX) & " AppPixelsY = " & Str(AppPixelsY) & Chr(13)
& "ScrollColPoints = " & Str(ScrollColPoints) & " ScrollRowPoints = " & Str(ScrollRowPoints) & Chr(13)
& "ScrollPixelsX = " & Str(ScrollPixelsX) & " ScrollPixelsY = " & Str(ScrollPixelsY
Els
Result.Selec
MsgBox "Result Is Picture. TopLeftCell.Address = " & Result.TopLeftCell.Address & Chr(13)
& "ResultPointsX = " & Str(Result.Left) & " ResultPointsY = " & Str(Result.Top) & Chr(13)
& "ResultPixelsX = " & Str(ActiveWindow.PointsToScreenPixelsX(Result.Left)) & " ResultPixelsY = "
& Str(ActiveWindow.PointsToScreenPixelsY(Result.Top)) & Chr(13)
& "CellPointsX = " & Str(CellPointsX) & " CellPointsY = " & Str(CellPointsY) & Chr(13) _
& "CellPixelsX = " & Str(CellPixelsX) & " CellPixelsY = " & Str(CellPixelsY) & Chr(13) _
& "WndPointsX = " & Str(WndPointsX) & " WndPointsY = " & Str(WndPointsY) & Chr(13) _
& "WndPixelsX = " & Str(WndPixelsX) & " WndPixelsY = " & Str(WndPixelsY) & Chr(13) _
& "AppPointsX = " & Str(AppPointsX) & " AppPointsY = " & Str(AppPointsY) & Chr(13) _
& "AppPixelsX = " & Str(AppPixelsX) & " AppPixelsY = " & Str(AppPixelsY) & Chr(13) _
& "ScrollColPoints = " & Str(ScrollColPoints) & " ScrollRowPoints = " & Str(ScrollRowPoints) & Chr(13) _
& "ScrollPixelsX = " & Str(ScrollPixelsX) & " ScrollPixelsY= " & Str(ScrollPixelsY)
End If
End If

End Sub

 

[Guest]

That code will become unbearably slow because there will be hundreds of shapes on the page (don't ask)...

 

[Tom Ogilvy]

You might be surprised.

--
Regards,
Tom Ogilvy

That code will become unbearably slow because there will be hundreds of

shapes on the page (don't ask)...

 

[Guest]

No, I would not be surprised. I ran a piece of code even even shorter than yours BEFORE I posted my original question and, as I had predicted, it really slowed down after less than 100 shapes were added. You're the one who would be in for a surprise if you found out what the code is for. Then you would understand why I really need the RangeFromPoint command to work.

 

[Tom Ogilvy]

Who is your audience? Anyone using xl97?

--
Regards,
Tom Ogilvy

No, I would not be surprised. I ran a piece of code even even shorter

than yours BEFORE I posted my original question and, as I had predicted, it
really slowed down after less than 100 shapes were added. You're the one
who would be in for a surprise if you found out what the code is for. Then
you would understand why I really need the RangeFromPoint command to work.

 

[Guest]

The audience is people who will probably often have computers just as slow as my 4-year old 500mhz laptop! ;-)

 

[Tom Ogilvy]

The point was that the function you are trying to use doesn't exit in xl97,
so if they have old computers, they will probably have old software too.

--
Regards,
Tom Ogilvy

The audience is people who will probably often have computers just as slow

as my 4-year old 500mhz laptop! ;-)

 

[Guest]

I had to ditch '97 and move to 2000 Premium. I definitely will not be offering it to run on '97; I can't remember, but I had some other problem with '97. Meantime, I want to move on to fix another problem, and will make a new post.

 

[excelthoughts]

I know this thread in 4 years old, but do you remember what you ended up doing here?
I am having other difficulties with RangeFromPoint in Excel 2007.