Страницы: 1
RSS
Удаление макросов из нескольких книг макросом
 
Уважаемые пользователи 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, сохранить и закрыть.  
 
Помогите пожалуйста.
 
А вы на время работы своего макроса отключайте обработку событий типа Workbook_Open в открываемых книгах:  
(а то эти макросы запускаются, и мешают вашему коду)  
 
 
' в начале макроса  
application.EnableEvents=False    
 
' весь ваш код  
 
' включаем события снова  
application.EnableEvents=true
 
Спасибо Вам огромное. Заработало!!!!!!!!!!!!!!!  
Не ожидал такого быстрого ответа.
Страницы: 1
Читают тему
Наверх