Deleting pictures.

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Deleting pictures.

Post by Bomba »

I found this code (below) that delete all pictures in a workbook. Does this code be modified to delete all pictures in all workbooks in a folder?

Code: Select all

 Sub DeleteAllObjects()
    Dim wsh As Worksheet
    Dim i As Long
    Application.ScreenUpdating = False
    For Each wsh In ActiveWorkbook.Worksheets
        For i = wsh.Shapes.Count To 1 Step -1
            wsh.Shapes(i).Delete
        Next i
    Next wsh
    Application.ScreenUpdating = True
End Sub
Thanks

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

You have to loop through the workbooks in the folder.
Change the constant strFolder, but keep the \ at the end.

Code: Select all

Sub DeleteAllObjectsInFolder()
    Const strFolder = "C:\Excel\"
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim i As Long
    Application.ScreenUpdating = False
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strFolder & strFile, UpdateLinks:=False)
        For Each wsh In wbk.Worksheets
            For i = wsh.Shapes.Count To 1 Step -1
                wsh.Shapes(i).Delete
            Next i
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

That code works perfect but I forgot that in every workbook I have a sheet named "DASH" with a picture that I don't want to delete. Will the same code be modified so that pictures in sheets "DASH" don't be deleted.
Thanks in advance

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

Code: Select all

Sub DeleteAllObjectsInFolder()
    Const strFolder = "C:\Excel\"
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim i As Long
    Application.ScreenUpdating = False
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strFolder & strFile, UpdateLinks:=False)
        For Each wsh In wbk.Worksheets
            If UCase(wsh.Name) <> "DASH" Then
                For i = wsh.Shapes.Count To 1 Step -1
                    wsh.Shapes(i).Delete
                Next i
            End If
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

Hi,
I tried that code and still removed all shapes, pictures...etc in sheets "Dash". I had even a command button that was removed.
Thanks

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

Perhaps the sheet us named "DASH " or " DASH" (i.e. with an extra space)?
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

No, there are no spaces in the sheet name.

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

In that case, I don't understand what's happening. I have tested the code on a workbook with (among others) a sheet named DASH. Shapes on this sheet were not deleted:

S3503.png
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

May I send you the folder?

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

Sure, go ahead.
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

Hi,
Here you have the link of the folder. https://www.dropbox.com/s/0g7mmznd7pfxg ... 9.zip?dl=0
Another thing is that some of the sheets with pictures are protected. When I run the code, they became unorotected. I need to keep them protected if possible and sheet name is "Dash" not "DASH".
Thanks

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

The problem is that you have event procedures that automatically unprotect sheets. Try this version:

Code: Select all

Sub DeleteAllObjectsInFolder()
    Const strFolder = "C:\Excel\"
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim i As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strFolder & strFile, UpdateLinks:=False)
        For Each wsh In wbk.Worksheets
            If UCase(wsh.Name) <> "DASH" And wsh.ProtectContents = False Then
                For i = wsh.Shapes.Count To 1 Step -1
                    wsh.Shapes(i).Delete
                Next i
            End If
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Don't forget to adjust the path.
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

It seems that with this code, pictures remain there when sheet is protected.
Thanks

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

I thought that was what you wanted...
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

I wanted to remove all pictures in workbooks except that of sheets "Dash" and those sheets that were protected, remain protected.

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

How about this version?

Code: Select all

Sub DeleteAllObjectsInFolder()
    Const strFolder = "C:\...\2. February 2019\"
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim i As Long
    Dim f As Boolean
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strFolder & strFile, UpdateLinks:=False)
        For Each wsh In wbk.Worksheets
            If UCase(wsh.Name) <> "DASH" Then
                f = wsh.ProtectContents
                If f Then
                    wsh.Unprotect
                End If
                For i = wsh.Shapes.Count To 1 Step -1
                    wsh.Shapes(i).Delete
                Next i
                If f Then
                    wsh.Protect
                End If
            End If
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

With this code, the sheets remained protected but pictures in sheets "Dash" were removed.

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

It doesn't when I run the macro on your sample workbooks:

S3507.png

I have no idea why it doesn't work correctly for you
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

Bomba
3StarLounger
Posts: 281
Joined: 20 Jan 2019, 19:43

Re: Deleting pictures.

Post by Bomba »

Sorry Master, its my fault. I left the old code. If I want to add another sheet like sheet "Dash", what will I have to add to the code? For example I want sheets "Dash" and "Rep36".
Thanks

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Deleting pictures.

Post by HansV »

Code: Select all

Sub DeleteAllObjectsInFolder()
    Const strFolder = "C:\...\2. February 2019\"
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim i As Long
    Dim f As Boolean
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strFolder & strFile, UpdateLinks:=False)
        For Each wsh In wbk.Worksheets
            Select Case UCase(wsh.Name)
                Case "DASH", "REP36" ' convert all names to upper case!
                    ' Skip these sheets
                Case Else
                    f = wsh.ProtectContents
                    If f Then
                        wsh.Unprotect
                    End If
                    For i = wsh.Shapes.Count To 1 Step -1
                        wsh.Shapes(i).Delete
                    Next i
                    If f Then
                        wsh.Protect
                    End If
            End Select
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans