Страницы: 1
RSS
Удаление макросов в активном листе
 
Скопирован лист1 (с созданием копии) в котором содержится определённый макрос (то есть получается, что созданный Лист1(2) так же содержит макрос под таким же именем как и лист1.
Как удалить макрос с активного листа, которым является Лист1(2), не затрагивая макроса который находиться в Листе1?  Имя (имена)  удаляемого макроса должно быть прописано в коде макроса убийцы.
Есть следующий код единственно, который нашла на форуме от Pavel55:
Код
Sub DeleteProcedure()   
Dim iProcedure As String   
Dim iVBComponent As Object   
Dim iStartLine As Long   
Dim iCountLines As Long   
Dim Killed As Boolean   
    iProcedure = InputBox(Prompt:="Введите имя макроса," & _   
    vbCrLf & "который требуется удалить", Title:="Удаление макроса";)   
    If iProcedure$ = "" Then _   
    MsgBox "Вы не указали имя ненужного макроса", 48, "Ошибка": Exit Sub   
    For Each iVBComponent In ActiveWorkbook.VBProject.VBComponents   
        With iVBComponent.CodeModule   
             If .Find("Sub " & _   
                iProcedure$, 1, 1, .CountOfLines, 1) = True Then   
                iStartLine& = .ProcStartLine(iProcedure$, 0)   
                iCountLines& = .ProcCountLines(iProcedure$, 0)   
                .DeleteLines iStartLine&, iCountLines&   
                Killed = True   
                Exit For   
             End If   
        End With   
    Next   
    If Killed = True Then   
        MsgBox "Макрос " & iProcedure$ & " удалён!", 64, "Удаление макроса"   
    Else   
        MsgBox "Макрос " & iProcedure$ & " не найден!", 48, "Удаление макроса"   
    End If   
End Sub
Но после копирования листа и запуска этого макроса, удаляется макрос в Листе 1, но никак не в активном Листе1(2).
Так же этот макрос выводит форму для ввода имени удаляемого макроса, что совершенно ненужно. Помогите решить задачу плиииз!
 
Цитата
код единственно, который нашла на форуме
а в остальном интернете?
например

Лариса, наберите в Яндексе Удаление модуля VBA, куча ссылок
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал: ...Удаление модуля VBA, куча ссылок
Удаление модуля - да, удаление макросов в книге - да, удаление макроса по имени в активном листе - нет, наберите в яндексе...
 
Лариса, удалять часть проекта из этого же проекта - это как самому себе аппендикс вырезать. Следует избегать таких методов.
Что за макрос в Лист1? Уберите его оттуда. Если обычная процедура или функция - перенесите в обычный модуль.
Если обработчик события типа Private Sub Worksheet_Change - перенесите в модуль книги в Private Sub Workbook_SheetChange с проверкой на нужный лист.
 
Хороший ответ, как-то так, да, представлялось... вот только как быть с проверкой на этот самый нужный лист ... :(
Как бы тот самый макрос:
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("cell1") <> "" Then
    Application.EnableEvents = False
       
       Range("cell1").EntireRow.Insert
       Range("rw1").Copy Destination:=Range("rw1").Offset(-1)
       Range("rw1").SpecialCells(xlCellTypeConstants, 23).ClearContents
       
       Range("rw2").EntireRow.Insert
       Range("rw2").Copy Destination:=Range("rw2").Offset(-1)
       'Range("rw2").SpecialCells(xlCellTypeConstants, 23).ClearContents

    Application.EnableEvents = True
    End If
End Sub

Изменено: Лариса - 26.03.2015 16:02:00
 
Кстати, я пробовала его положить в модуль книги, не работает... видать не хватает той самой проверки на нужный лист...
 
Какой код надо вставить, что бы макрос заработал с модуля книги?
 
Попробуйте в коде книги просто дописать вызов этой процедуры (ее кстати и в обычный модуль можно поместить, только Private убрать)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("cell1") <> "" Then
    Application.EnableEvents = False
        
       Range("cell1").EntireRow.Insert
       Range("rw1").Copy Destination:=Range("rw1").Offset(-1)
       Range("rw1").SpecialCells(xlCellTypeConstants, 23).ClearContents
        
       Range("rw2").EntireRow.Insert
       Range("rw2").Copy Destination:=Range("rw2").Offset(-1)
       'Range("rw2").SpecialCells(xlCellTypeConstants, 23).ClearContents
 
    Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name = "ИмяНужногоЛиста" Then Worksheet_Change Target
End Sub
 
Спасибо Казанский, то что надо!
Страницы: 1
Наверх