Delete Worksheets with a Background

[Gary's Student]

I have a set of workbooks each of which contain many worksheets. I need to examine each sheet and if it contains an applied Background, delete that sheet.

This is easy to do manually, but very tedious. Can it be accomplished with a macro?

 

[wigi]

Well done !

 

[shg]

In Sheet1.xml, I find this if the sheet has a background:

< picture r:id="rId2"/>

The picture itself is in the media folder.

 

[Teeroy]

Wow, great thinking!

Thanks Shg. From an MVP here that's high praise.

Form a bit of testing (I can never resist a problem) you could rename the file to a .zip then run the following which returns a string list of sheets that have references.

Sub Test3()
strZipFilename = "C:\Test" & "\" & "Book1.zip"
result = ListZip(strZipFilename)
MsgBox result
End Sub

Function ListZip(SrcFile)
    Set oApp = CreateObject("Shell.Application")
    For Each fileNameInZip In oApp.Namespace(SrcFile).Items
        If fileNameInZip.IsFolder = True Then
            result = ListZip(fileNameInZip)
        Else
            result = fileNameInZip
        End If
        'check for file *.rels
        If Len(result) Then
            If UBound(Split(result, ",")) < 2 Then
                If Right(result, 5) = ".rels" And Left(Split(result, ".")(0), 5) = "sheet" Then
                    ListZip = ListZip & "," & result
                End If
            Else
                ListZip = Right(result, Len(result) - 1)
            End If
        End If
    Next
    Set oApp = Nothing
End Function

This code could be wrapped in a DIR to go through a folder, rename the excel files to a zip, collect the string of suspect sheets (I'm not sure what else may be in the rels XML file) and workbook name into a scripting dictionary, then rename the file back.

You then run through the dictionary, open the workbook and loop through the sheets with a userform (or msgbox) asking if you want to delete it.

There's still a little bit of manual involvement but if you did enough testing to be certain what was in the .rels XML file you could completely automate it.

 

[shg]

Color me impressed.

 

[Teeroy]

Well done !

Thanks Wigi.

Color me impressed.

Now it's up to Gary's Student to make the most of it.

 

[wigi]

Wonderful, nice work.

 

[Jaafar Tribak]

Hi all,

I have posted a similar question HERE but the zipping workaround won't work for xls files (xl 2003 or earlier)

Any other idea ?

 

[StephenCrump]

A bit circuitous, but what about:

- Copy the sheet
- Save it
- Delete background picture
- Save it again
- Compare file sizes

 

[Jaafar Tribak]

A bit circuitous, but what about:

- Copy the sheet
- Save it
- Delete background picture
- Save it again
- Compare file sizes

Thank you Stephen .. like you said, a bit circuitous and would be too slow and complicated ..

Imagine I had a workbook with 30 worksheets (one for each day of the month) and wanted to find out which among the 30 worksheets has a background picture .. If I was to use the approach you kindly suggested, I would have to copy the workbook to disk ,open the copy, delete the worksheet background picture, save again and then compare the file sizes ... Plus, I would have to repeat all these steps 30 times, once for each worksheet !!

Even the unzipping approach would be far too slow and inpractical plus the fact that it woudn't work for .xls files.. I am hoping to find a more direct vba way without the need to mess with files/folders/unzipping .. etc

Regards

 

[Teeroy]

@Jaafar Tribak, I can't think of another way. As @SHG mentioned this isn't exposed in the object model.

You could save the XLS as an XLSM then use the ZIP method. You could further automate the method using a combination of VBScript and VBA to do the file conversion.

Please post back if you find another way, you've got me intrigued.