Deletion problem

[Francis Hookham]

Several rows need to be deleted but the area contains some text boxes which
are not deleted - they are 'squashed up' between the row above and the row
below the range deleted. I do not know if it will matter if they remain but
I should like to get rid of them. The trouble is they cannot be selected
because their names vary.

This recorded macro worked, of course, for this unique arrangement:

Sub Macro3()
ActiveSheet.Shapes.Range(Array("Text Box 5", "Text Box 1730", "Text Box
1732", _
"AutoShape 1734")).Select
Selection.Delete
ActiveCell.Rows("1:17").EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveCell.Select
End Sub

Is there a way of selecting ANY objects within an range of cells
irrespective of their names - a 'Select All' between RowX and RowY? If so
whatever was gathered up in this way could be deleted.

Francis Hookham

 

[Barb Reinhardt]

I'm guessing you could gather the TopLeftCell and the BottomRightCell of the
shape and delete using that.

Dim myShape as shape
For Each myShape In ActiveSheet.Shapes
Debug.Print myShape.Name, myShape.Placement, _
myShape.BottomRightCell.Address, myShape.TopLeftCell.Address
Next myShape

HTH

 

[Dave Peterson]

Dim myRng as range
dim myShape as shape

with worksheets("Sheet999")
set myrng = .range("a1:a7").entirerow
for each myshape in .shapes
if intersect(myshape.topleftrow, myrng) is nothing then
'top left corner not in that range, skip it
else
'top left corner is in that range
myshape.delete
end if
next myshape
end with

(Untested, uncompiled.)

But be careful. There are lots of things that qualify for shapes that you may
not want to delete.

I'd review Ron de Bruin's site before I started deleting shapes.
http://www.rondebruin.nl/controlsobjectsworksheet.htm

 

[Francis Hookham]

Thank you Barb - that was prompt response. I have inserted your suggestion
into the macro I had written - here it is but it does not help - the text
boxes are still squashed up to the top edge of the range.

Any suggestions?

Francis

Dim myShape As Shape

'Remove an unwanted scene
Sub DeleteScene()
'prevent wasting time but stopping updating of screen
Application.ScreenUpdating = False
'find and select insertion point
Count = ActiveCell.Row
While Cells(Count, 2) <> "Scene:" 'a sure way of finding the top row,
whichever cell had been selected
Count = Count - 1
Wend
Cells(Count, 1).Select

Range(Cells(Count - 1, 1), Cells(Count + 16, 8)).Select

For Each myShape In ActiveSheet.Shapes
Debug.Print myShape.Name, myShape.Placement, _
myShape.BottomRightCell.Address,
myShape.TopLeftCell.Address
Next myShape

'select 17 rows and delete them
ActiveCell.Rows("1:17").EntireRow.Delete Shift:=xlUp
'reset formulas
Cells(ActiveCell.Row, 3) = "=R[-17]C+0.01"
Cells(ActiveCell.Row, 7) =
"=IF(ISNUMBER(RC[-2]),R[-17]C+RC[-2]/86400,"""")"
'renumber frames
RenumberFrames
'run SetPrintArea macro
SetPrintArea
End Sub

 

[Francis Hookham]

Many thanks Dave - too late this evening and away for a couple of days so
will check it out in at the weekend.

I am most grateful

Francis

 

[Dave Peterson]

Barb's code just showed you how to use .topleftcell.address (and
..bottomrightcell.address).

She didn't include the code to check to see if the shapes were in your range --
or the code to delete it if it were in that range.

Thank you Barb - that was prompt response. I have inserted your suggestion
into the macro I had written - here it is but it does not help - the text
boxes are still squashed up to the top edge of the range.

Any suggestions?

Francis

Dim myShape As Shape

'Remove an unwanted scene
Sub DeleteScene()
'prevent wasting time but stopping updating of screen
Application.ScreenUpdating = False
'find and select insertion point
Count = ActiveCell.Row
While Cells(Count, 2) <> "Scene:" 'a sure way of finding the top row,
whichever cell had been selected
Count = Count - 1
Wend
Cells(Count, 1).Select

Range(Cells(Count - 1, 1), Cells(Count + 16, 8)).Select

For Each myShape In ActiveSheet.Shapes
Debug.Print myShape.Name, myShape.Placement, _
myShape.BottomRightCell.Address,
myShape.TopLeftCell.Address
Next myShape

'select 17 rows and delete them
ActiveCell.Rows("1:17").EntireRow.Delete Shift:=xlUp
'reset formulas
Cells(ActiveCell.Row, 3) = "=R[-17]C+0.01"
Cells(ActiveCell.Row, 7) =
"=IF(ISNUMBER(RC[-2]),R[-17]C+RC[-2]/86400,"""")"
'renumber frames
RenumberFrames
'run SetPrintArea macro
SetPrintArea
End Sub

I'm guessing you could gather the TopLeftCell and the BottomRightCell of
the
shape and delete using that.

Dim myShape as shape
For Each myShape In ActiveSheet.Shapes
Debug.Print myShape.Name, myShape.Placement, _
myShape.BottomRightCell.Address,
myShape.TopLeftCell.Address
Next myShape

HTH

 

[Francis Hookham]

Dave - I was away for Easter and have now tried your suggestion (see macro
below) but it stops at:



If Intersect(myShape.topleftrow, myRng) Is Nothing Then



with the error message



Run-time error message "438"

object does not support this property or message



I have run the macro several times including:



before deleting the area, setting 'myRng' a row above and below where the
objects appear.



after deleting the range and then running the macro covering two rows where
the objects have been compressed to the division between the two rows.



but without success. The objects are three text boxes and one AutoShape.



(This is part of a Storyboard spreadsheet where a standard 'Shot' is copied
and pasted in many times from another sheet. From time to time one of the
shots must be deleted. The shot is a range of cells 16R x 6C every at 17R
intervals containing Text Boxes 5, 1730 and 1734 and AutoShape 1734.)



Can you help further please.



Francis



From my macro:



Sub DeleteUnwantedImages()

Dim myRng As Range

Dim myShape As Shape



With Worksheets("Storyboard")

Set myRng = .Range("a35:a56").EntireRow

' Set myRng = .Range("a37:a52").EntireRow

For Each myShape In .Shapes

If Intersect(myShape.topleftrow, myRng) Is Nothing Then

'top left corner not in that range, skip it

Else

'top left corner is in that range

myShape.Delete

End If

Next myShape

End With



End Sub

 

[Dave Peterson]

It was a stupid typo:

Try using: myShape.TopLeftCell

 

[Francis Hookham]

Wow! Thanks Dave - that's great.

It was a stupid typo:

Try using: myShape.TopLeftCell