![]() |
Deleting shapes
Is there a macro I can run to delete shapes from
spreadsheet? I am pasting contents from another source into the current project. I have recorded a macro to go through and delete all the shapes. But it does not work. The title of the shapes change with every paste. so the macro can't find that specific shape. Can anyone help? Thanks for your time, Steve |
Deleting shapes
for each shp in Activesheet.Shapes
shp.Delete Next or Activesheet.Shapes.SelectAll Selection.Delete -- Regards, Tom Ogilvy "Steve" wrote in message ... Is there a macro I can run to delete shapes from spreadsheet? I am pasting contents from another source into the current project. I have recorded a macro to go through and delete all the shapes. But it does not work. The title of the shapes change with every paste. so the macro can't find that specific shape. Can anyone help? Thanks for your time, Steve |
Deleting shapes
Any of these should work. I use the first one.
Sub ShapesCut() For Each S In ActiveSheet.Shapes S.Cut Next End Sub 'or Sub shapescut1() 'Tom Ogilvy ActiveSheet.Shapes.SelectAll Selection.Delete End Sub Sub ShapesALLinWorkbookDelete() 'Deletes all in WORKBOOK Dim sh As Worksheet For Each sh In ActiveWorkbook.Worksheets sh.DrawingObjects.Delete Next sh End Sub Sub ShapesInRangeDelete() 'Iain Dim shpLoop As Shape Set rngUsable = Range("e1:e24") For Each shpLoop In ActiveSheet.Shapes 'does the top left corner of the shape overlap rngUsable? If Not (Application.Intersect(rngUsable, shpLoop.TopLeftCell) Is Nothing) Then shpLoop.Delete End If Next shpLoop End Sub Sub RemoveObjectsFromSelection() 'Jake Marx MVP Dim ole As OLEObject Dim shp As Shape For Each ole In Selection.Parent.OLEObjects If Not Application.Intersect(Selection, _ ole.TopLeftCell) Is Nothing Then ole.Delete End If Next ole For Each shp In Selection.Parent.Shapes If Not Application.Intersect(Selection, _ shp.TopLeftCell) Is Nothing Then shp.Delete End If Next shp End Sub -- Don Guillett SalesAid Software "Steve" wrote in message ... Is there a macro I can run to delete shapes from spreadsheet? I am pasting contents from another source into the current project. I have recorded a macro to go through and delete all the shapes. But it does not work. The title of the shapes change with every paste. so the macro can't find that specific shape. Can anyone help? Thanks for your time, Steve |
Deleting shapes
1st one worked great. thanks for the help.
Steve -----Original Message----- Any of these should work. I use the first one. Sub ShapesCut() For Each S In ActiveSheet.Shapes S.Cut Next End Sub 'or Sub shapescut1() 'Tom Ogilvy ActiveSheet.Shapes.SelectAll Selection.Delete End Sub Sub ShapesALLinWorkbookDelete() 'Deletes all in WORKBOOK Dim sh As Worksheet For Each sh In ActiveWorkbook.Worksheets sh.DrawingObjects.Delete Next sh End Sub Sub ShapesInRangeDelete() 'Iain Dim shpLoop As Shape Set rngUsable = Range("e1:e24") For Each shpLoop In ActiveSheet.Shapes 'does the top left corner of the shape overlap rngUsable? If Not (Application.Intersect(rngUsable, shpLoop.TopLeftCell) Is Nothing) Then shpLoop.Delete End If Next shpLoop End Sub Sub RemoveObjectsFromSelection() 'Jake Marx MVP Dim ole As OLEObject Dim shp As Shape For Each ole In Selection.Parent.OLEObjects If Not Application.Intersect(Selection, _ ole.TopLeftCell) Is Nothing Then ole.Delete End If Next ole For Each shp In Selection.Parent.Shapes If Not Application.Intersect(Selection, _ shp.TopLeftCell) Is Nothing Then shp.Delete End If Next shp End Sub -- Don Guillett SalesAid Software "Steve" wrote in message ... Is there a macro I can run to delete shapes from spreadsheet? I am pasting contents from another source into the current project. I have recorded a macro to go through and delete all the shapes. But it does not work. The title of the shapes change with every paste. so the macro can't find that specific shape. Can anyone help? Thanks for your time, Steve . |
Deleting shapes
|
All times are GMT +1. The time now is 09:08 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com