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
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
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
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
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.
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
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
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
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
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