PC Review


Reply
Thread Tools Rate Thread

delete drawings in a centain selection

 
 
bartman1980
Guest
Posts: n/a
 
      26th Oct 2007
I tried to delete all the drawings in a certain selection.

sub deletedrawings()
Sheets("Resultaat").Select
Range("A60:H60").Select
Range("H60").Activate
Range(Selection, Selection.End(xlDown)).Select
activecells.DrawingObjects(1).Delete
Selection.ClearContents
end sub

But he gives an error on the line:
activecells.DrawingObjects(1).Delete

Note: searching and fine the drawing isn't an option because this is
totally random.
I just want to delete all drawings ans cells in the selection I made.

 
Reply With Quote
 
 
 
 
Ken Johnson
Guest
Posts: n/a
 
      26th Oct 2007
On Oct 26, 6:58 pm, bartman1980 <bartman1...@hotmail.com> wrote:
> I tried to delete all the drawings in a certain selection.
>
> sub deletedrawings()
> Sheets("Resultaat").Select
> Range("A60:H60").Select
> Range("H60").Activate
> Range(Selection, Selection.End(xlDown)).Select
> activecells.DrawingObjects(1).Delete
> Selection.ClearContents
> end sub
>
> But he gives an error on the line:
> activecells.DrawingObjects(1).Delete
>
> Note: searching and fine the drawing isn't an option because this is
> totally random.
> I just want to delete all drawings ans cells in the selection I made.


Maybe something like this...

Public Sub DeleteShpsWithTLCell_InSelection()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Not Intersect(Shp.TopLeftCell, Selection) Is Nothing Then
Shp.Delete
End If
Next Shp
End Sub

Ken Johnson

 
Reply With Quote
 
paul.robinson@it-tallaght.ie
Guest
Posts: n/a
 
      26th Oct 2007
On Oct 26, 9:58 am, bartman1980 <bartman1...@hotmail.com> wrote:
> I tried to delete all the drawings in a certain selection.
>
> sub deletedrawings()
> Sheets("Resultaat").Select
> Range("A60:H60").Select
> Range("H60").Activate
> Range(Selection, Selection.End(xlDown)).Select
> activecells.DrawingObjects(1).Delete
> Selection.ClearContents
> end sub
>
> But he gives an error on the line:
> activecells.DrawingObjects(1).Delete
>
> Note: searching and fine the drawing isn't an option because this is
> totally random.
> I just want to delete all drawings ans cells in the selection I made.


Hi
ActiveCells does not have a DrawingObjects property, hence the error.
try this, which will delete any shape whose top left corner or bottom
rigth corner is in the range (though you might only have the bottom
left corner in the range....puzzle that one out yourself!)

Sub deletedrawings()
Dim myShape As Shape
Sheets("Resultaat").Select
Range("A60:H60").Select
Range("H60").Activate
Set myRange = Range(Selection, Selection.End(xlDown))
myRange.Select
For Each myShape In Sheets("Resultaat").Shapes
Set Testrange1 = Intersect(myShape.TopLeftCell, myRange)
Set TestRange2 = Intersect(myShape.BottomRightCell, myRange)
If Not TestRange1 Is Nothing Or Not TestRange2 Is Nothing Then
myShape.Delete
End If
Next myShape
Selection.ClearContents
End Sub

regards
Paul

 
Reply With Quote
 
Bob Phillips
Guest
Posts: n/a
 
      26th Oct 2007
Sub deletedrawings()
Dim rngTop As Double
Dim rngBottom As Double
Dim rngLeft As Double
Dim rngRight As Double
Dim shp

'Sheets("Resultaat").Select
With Range("A60:H60")
rngTop = .Top
rngBottom = rngTop + .Height
rngLeft = .Left
rngRight = rngLeft + .Width
For Each shp In ActiveSheet.DrawingObjects
If shp.Top <= rngBottom And shp.Top + shp.Height >= rngTop And _
shp.Left <= rngRight And shp.Left + shp.Width >= rngLeft
Then
shp.Delete
End If
Next shp
.ClearContents
End With
End Sub


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"bartman1980" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>I tried to delete all the drawings in a certain selection.
>
> sub deletedrawings()
> Sheets("Resultaat").Select
> Range("A60:H60").Select
> Range("H60").Activate
> Range(Selection, Selection.End(xlDown)).Select
> activecells.DrawingObjects(1).Delete
> Selection.ClearContents
> end sub
>
> But he gives an error on the line:
> activecells.DrawingObjects(1).Delete
>
> Note: searching and fine the drawing isn't an option because this is
> totally random.
> I just want to delete all drawings ans cells in the selection I made.
>



 
Reply With Quote
 
bartman1980
Guest
Posts: n/a
 
      26th Oct 2007
On 26 okt, 11:46, Ken Johnson <KenCJohn...@gmail.com> wrote:
> On Oct 26, 6:58 pm, bartman1980 <bartman1...@hotmail.com> wrote:
>
>
>
>
>
> > I tried to delete all the drawings in a certain selection.

>
> > sub deletedrawings()
> > Sheets("Resultaat").Select
> > Range("A60:H60").Select
> > Range("H60").Activate
> > Range(Selection, Selection.End(xlDown)).Select
> > activecells.DrawingObjects(1).Delete
> > Selection.ClearContents
> > end sub

>
> > But he gives an error on the line:
> > activecells.DrawingObjects(1).Delete

>
> > Note: searching and fine the drawing isn't an option because this is
> > totally random.
> > I just want to delete all drawings ans cells in the selection I made.

>
> Maybe something like this...
>
> Public Sub DeleteShpsWithTLCell_InSelection()
> Dim Shp As Shape
> For Each Shp In ActiveSheet.Shapes
> If Not Intersect(Shp.TopLeftCell, Selection) Is Nothing Then
> Shp.Delete
> End If
> Next Shp
> End Sub
>
> Ken Johnson- Tekst uit oorspronkelijk bericht niet weergeven -
>
> - Tekst uit oorspronkelijk bericht weergeven -


Hi Ken,
This works perfect!
Thanks!

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Re: Delete all drawings/shapes except DownArrows Dave Peterson Microsoft Excel Programming 0 23rd Feb 2011 12:55 PM
delete drwaings in a centain selection bartman1980 Microsoft Excel Programming 1 26th Oct 2007 01:53 PM
Copy Selection - Paste Selection - Delete Selection Uninvisible Microsoft Excel Programming 2 25th Oct 2007 01:31 PM
Copy Selection - Transpose Selection - Delete Selection Uninvisible Microsoft Excel Misc 2 23rd Oct 2007 04:18 PM
delete the white box that appears around drawings I save as jpegs =?Utf-8?B?TmF2eSB0b20=?= Microsoft Powerpoint 3 17th Aug 2006 01:52 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 10:24 PM.