Есть 2 макроса: 1-перебор книг в директории с форматом файла .xlsm 2-удаление всех макросов находящихся в книге.
Как можно объединить два этих макроса в один? Вкратце расскажу его суть: Есть необходимость удалить все макросы из всех файлов в определенной директории. Открывать каждый и удалять займет большое кол-во времени. Файл с обоими макросами как пример прилагаю.
Sub GetSubFolders(sPath)
Dim sPathSeparator As String, sObjName As String, curWb As Workbook
Set objFolder = objFSO.GetFolder(sPath)
For Each objFile In objFolder.Files
If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xlsm" Then
'открываем книгу
Set curWb = Workbooks.Open(sPath & objFile.Name)
DeleteVBA curWb
curWb.Close True
End If
Next
For Each objFolder In objFolder.SubFolders
GetSubFolders objFolder.Path & Application.PathSeparator
Next
End Sub
Sub DeleteVBA(wb As Workbook)
Dim VBComp As Object, cl As Object
If wb Is Nothing Then Set wb = ActiveWorkbook
Set VBComp = wb.VBProject.VBComponents
For Each cl In VBComp
cl.CodeModule.DeleteLines 1, cl.CodeModule.CountOfLines
Next
End Sub
Уважаемый Василька! Полагаю, Вы сами усложнили свою проблему: "Подскажите, есть ли способ удалить "Лист2" из нескольких файлов разом (файлов более 1000 в одной папке)"! Смотрите тривиальный макрос.
Как xlsx к сожалению сохранить файлы не проще, т.к. там несколько типов таблиц и некоторые файлы после конвертации в xlsx перестают открываться вовсе. Сейчас пробую код объединенный о результатах отпишусь)
Option Explicit
Sub iVBProjectClear()
' -----------------------------------------
Dim ikey, sVBProject As Object, sFile$
Dim book As Workbook, iPath$
' -----------------------------------------
With Application
.ScreenUpdating = False: .DisplayAlerts = False
End With
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> False Then iPath = .SelectedItems(1)
End With
sFile = Dir(iPath & Application.PathSeparator & "*.xlsm")
Do Until sFile = ""
If sFile <> ThisWorkbook.Name Then
Set book = Workbooks.Open(iPath & Application.PathSeparator & sFile)
Set sVBProject = book.VBProject
For Each ikey In sVBProject.VBComponents
Select Case ikey.Type
Case 1 To 3: ikey.Collection.Remove ikey
Case Else: Call MacroCodeDelete(sVBProject, ikey)
End Select
Next
book.Close True
End If
sFile = Dir
Loop
With Application
.ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub
Sub MacroCodeDelete(sVBProject As Object, ikey)
' -------------
Dim i&
' -------------
For i = ikey.CodeModule.CountOfLines To 2 Step -1
ikey.CodeModule.DeleteLines i
Next i
End Sub
Отлично подходит и очень быстро перебирает файлы, можете еще подсказать если в файле макросы редактируются по паролю, то куда необходимо ввести пароль в код VBA чтобы по умолчанию при просьбе ввести пароль он вводился (т.к. во всех файлах с защищенными макросами стоит один и тот же пароль). Вот пример: Файл с макросом на удаление макросов "DeleteVBA.xlsm" Файл пример в котором макрос под паролем (пароль 12345678) "Пример.xlsm"
Главный недостаток: снятие пароля данным методом весьма нестабильно и иногда может не срабатывать. Так же во время работы данного кода крайне нежелательно пользоваться мышью и клавиатурой. Точнее даже не нежелательно, а просто нельзя, если вам необходим положительный результат.
Я предпочитаю не пользоваться данным методом. А как решить ваш вопрос к сожалению у меня знаний не хватает
"Все гениальное просто, а все простое гениально!!!"