Find All Embedded Objects in Workbook

[Andibevan]

I have a problem with a worksheet saving and from reading things on the MS
KB it appears to be related to Embedded Objects, with the only suggested
solution being to delete them.

The problem I have is that my colleagues have a habit of making an embedded
object minute rather than deleting it. As a result I can't find the
mysterious embedded object.

How can I cycle through all the embedded objects on a worksheet?

TIA

Andi

 

[Peter T]

Hi Andi,

The problem I have is that my colleagues have a habit of making an embedded
object minute rather than deleting it.

People think deleting rows & columns will delete objects located therein,
whether embedded (inserted) or otherwise. It doesn't, just makes them very
thin or narrow.

F5 > Special > Objects

will select all

Not sure what you mean by "cycle through all the embedded objects", to do
what.

Regards,
Peter T

 

[Ron de Bruin]

hi Andibevan

See
http://www.rondebruin.nl/controlsobjectsworksheet.htm

 

[Tom Ogilvy]

Sub LocateShapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Select
shp.TopLeftCell.Select
MsgBox shp.Name & " . . . OK to continue"
Next

End Sub

 

[Andibevan]

Thanks for all the suggestions - much appreciated

Peter - in answer to your question - I would then be able to delete every
object (or perform some other action to identify them) in the worksheet.

Thanks

Andi

 

[Peter T]

Did you try tabbing (or Shift-tab). You need to select an object first, if
you can't see any add (say) a rectangle. If you can't tab beyond that one
then there aren't any others.

I should have clarified previously that the very thin / narrow resize of
objects in deleted rows / columns is with objects that are formatted to
"Move and size with cells"

Regards,
Peter T

 

[NickHK]

Andi,
I have the same requirement as colleague routinely add 2500~5000 minute
lines to workbooks, then deny having done anything at all.

I have a routine that will "clean" all files in a directory and save to
another directory. Bit rough and ready but I can send it to you if you wish.

NickHK

 

[Andibevan]

Thanks for the offer Nick - would it be possible to post the routine onto
here?

 

[NickHK]

Andi,

Public Function CleanLines(argXLFileName As String, argSaveFolder As String,
Optional argPW As String = "") As Long
Dim xlFile As Workbook
Dim XLWS As Worksheet
Dim i As Long
Dim LineToGo As Shape
Dim LineCount As Long

Application.ScreenUpdating = False
On Error Resume Next
Set xlFile = Workbooks.Open(argXLFileName, False, True, , argPW)
If Err.Number <> 0 Then
CleanLines = -1
Application.ScreenUpdating = True
Exit Function
End If
For Each XLWS In xlFile.Worksheets
If XLWS.Name <> "Costings" Then
'XLWS.Activate
For Each LineToGo In XLWS.Shapes
With LineToGo
If .Type = msoLine Then
'Add a Select case if you are looking for other objects
'but for me it is only msoLine
.Delete
LineCount = LineCount + 1
End If
End With
Next
End If
Next
xlFile.SaveAs argSaveFolder & xlFile.Name, , argPW
xlFile.Close
Set xlFile = Nothing
Application.ScreenUpdating = True
CleanLines = LineCount
End Function

NickHK

 

[Andibevan]

Thanks Nick )

Andi,

Public Function CleanLines(argXLFileName As String, argSaveFolder As String,
Optional argPW As String = "") As Long
Dim xlFile As Workbook
Dim XLWS As Worksheet
Dim i As Long
Dim LineToGo As Shape
Dim LineCount As Long

Application.ScreenUpdating = False
On Error Resume Next
Set xlFile = Workbooks.Open(argXLFileName, False, True, , argPW)
If Err.Number <> 0 Then
CleanLines = -1
Application.ScreenUpdating = True
Exit Function
End If
For Each XLWS In xlFile.Worksheets
If XLWS.Name <> "Costings" Then
'XLWS.Activate
For Each LineToGo In XLWS.Shapes
With LineToGo
If .Type = msoLine Then
'Add a Select case if you are looking for other objects
'but for me it is only msoLine
.Delete
LineCount = LineCount + 1
End If
End With
Next
End If
Next
xlFile.SaveAs argSaveFolder & xlFile.Name, , argPW
xlFile.Close
Set xlFile = Nothing
Application.ScreenUpdating = True
CleanLines = LineCount
End Function

NickHK