Уважаемые пользователи Excel помогите пожалуйста в таком вопросе. Мне нужно удалить из всех файлов Excel, находящихся в определённой папке все макросы.
Ранее я нашел макрос, к сожалению не помню где, который удаляет из текущей книги все макросы. Он прекрасно работает
Sub Delete_Macroses()
Dim oVBComponent As Object, lCountLines As Long
'Проверяем, защищен проект или нет
If ActiveWorkbook.VBProject.Protection = 1 Then
MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
" Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
Exit Sub
End If
For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
On Error Resume Next
With oVBComponent
Select Case .Type
Case 1 'Модули
.Collection.Remove oVBComponent
Case 2 'Модули Класса
.Collection.Remove oVBComponent
Case 3 'Формы
.Collection.Remove oVBComponent
Case 100 'ЭтаКнига, Листы
lCountLines = .CodeModule.CountOfLines
.CodeModule.DeleteLines 1, lCountLines
End Select
End With
Next
Set oVBComponent = Nothing
On Error GoTo 0
End Sub
Далее я сделал свой макрос, который открывает по очереди файлы в папке, вызывается процедура Delete_Macroses для удаления макросов и закрывает файлы с сохранением.
Sub Delete_Macroses_to_SP_regions()
Dim obrabativaemaya_kniga As String
Const fldr = "c:\CS_System_Planning\1\"
Set fs = CreateObject("Scripting.FileSystemObject")
For Each ff In fs.getfolder(fldr).Files
If Right(ff.Name, 4) = ".xls" Or Right(ff.Name, 5) = ".xlsm" Then
Workbooks.Open (fldr & ff.Name)
End If
obrabativaemaya_kniga = ff.Name
Windows(obrabativaemaya_kniga).Activate
Call Delete_Macroses
Windows(obrabativaemaya_kniga).Activate
Sheets(2).Select
ActiveWorkbook.Close True
Next
End Sub
Сначала мой макрос работал без проблем. Для меня самое главное удалить код с объекта ЭтаКнига во всех книгах в папке. Ранее когда в этом объекте был только Private Sub Workbook_BeforeClose(Cancel As Boolean) всё работало. Но недавно я дописал туда ещё Private Sub Workbook_Open() и начались проблемы. Макрос обрабатывает без проблем 2 файла, а затем на 3-м затыкается. Excel приносит свои извинения за неудобства, пишет что всё пропало и спрашивает: Восстановить документы и перезапустить Microsoft Office Excel. В процедуре Private Sub Workbook_Open() всего лишь вызываются 3 процедуры записанные в книге для обновления нескольких рядов данных на разных листах
Причём, если вручную делать туже саму операцию, то никаких проблем не возникает. Т.е. открыть файлик, запустить макрос Delete_Macroses, сохранить и закрыть.
Помогите пожалуйста.
