Удалить vba коды с листа excel

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 7 And Target.Row > 1 And Target.Cells.Count = 1 Then
        Set MyRange = ActiveCell
        Cancel = True
        wsDict.Select
       
       ' If Len(Target.Value) > 0 Then
           ' wsDict.Columns(1).AutoFilter Field:=1, Criteria1:="=" & Left$(Target.Value, 1) & "*"
       ' End If
    End If
    
 
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sNew As String
    If Target.Column = 7 Then
        With Application
            .EnableEvents = False
            sNew = Target.Value
            .Undo
            If Len(Target.Value) = 0 Then  
                Target.Value = sNew
            End If
            .EnableEvents = True
        End With
    End If
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 7 And Target.Row > 1 And Target.Cells.Count = 1 Then
        Set MyRange = ActiveCell
        Cancel = True
        wsDict.Select
       
       ' If Len(Target.Value) > 0 Then
           ' wsDict.Columns(1).AutoFilter Field:=1, Criteria1:="=" & Left$(Target.Value, 1) & "*"
       ' End If
    End If
    
 
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sNew As String
    If Target.Column = 7 Then
        With Application
            .EnableEvents = False
            sNew = Target.Value
            .Undo
            If Len(Target.Value) = 0 Then  
                Target.Value = sNew
            End If
            .EnableEvents = True
        End With
    End If
End Sub

1
2
3
4
5
6
7

Sub Del_ShCode()
    Dim lCountLines As Long
    With ActiveWorkbook.VBProject.VBComponents("Лист1")
        lCountLines = .CodeModule.CountOfLines
        .CodeModule.DeleteLines 1, lCountLines
    End With
End Sub

1

Activesheet.codename

1
2
3
4
5
6
7
8

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    .....
     
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
 ....
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Sub Delete_Sub_From_Module()
    Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents("Module2")
        'получаем кол-во строк кода в модуле
        lCountLines = .CodeModule.CountOfLines
        'получаем первую строку с кодом, исключая строки декларирования функции и опций модуля
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        'цикл по всем строкам кода внутри модуля
        For li = lStartLine To lCountLines
            'получаем имя процедуры/функции, внутри которой строка кода
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'если имя процедуры совпадает с тем, которое нам нужно
            If sProcName = "Code2" Then
                'узнаем кол-во строк процедуры/функции
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'удаляем процедуру/функцию
                .CodeModule.DeleteLines li, lProcLineCount - 1
                Exit For
            End If
            li = li + lProcLineCount
        Next li
    End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Sub red_r()
Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents("Ëèñò1")
        'ïîëó÷àåì êîë-âî ñòðîê êîäà â ìîäóëå
        lCountLines = .CodeModule.CountOfLines
        'ïîëó÷àåì ïåðâóþ ñòðîêó ñ êîäîì, èñêëþ÷àÿ ñòðîêè äåêëàðèðîâàíèÿ ôóíêöèè è îïöèé ìîäóëÿ
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        'öèêë ïî âñåì ñòðîêàì êîäà âíóòðè ìîäóëÿ
        For li = lStartLine To lCountLines
            'ïîëó÷àåì èìÿ ïðîöåäóðû/ôóíêöèè, âíóòðè êîòîðîé ñòðîêà êîäà
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'åñëè èìÿ ïðîöåäóðû ñîâïàäàåò ñ òåì, êîòîðîå íàì íóæíî
            If sProcName = "Worksheet_BeforeDoubleClick" Then
                'óçíàåì êîë-âî ñòðîê ïðîöåäóðû/ôóíêöèè
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'óäàëÿåì ïðîöåäóðó/ôóíêöèþ
                .CodeModule.DeleteLines li, lProcLineCount - 1
                Exit For
            End If
            li = li + lProcLineCount
        Next li
    End With
End Sub

1
2

Option Explicit
End Sub

1

.CodeModule.DeleteLines li, lProcLineCount - 1

1

.CodeModule.DeleteLines li, lProcLineCount

1

If sProcName = "Worksheet_BeforeDoubleClick" or sProcName = "имя другой процедуры" Then

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Sub red_r()
Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents("Ëèñò1")
        'ïîëó÷àåì êîë-âî ñòðîê êîäà â ìîäóëå
        lCountLines = .CodeModule.CountOfLines
        'ïîëó÷àåì ïåðâóþ ñòðîêó ñ êîäîì, èñêëþ÷àÿ ñòðîêè äåêëàðèðîâàíèÿ ôóíêöèè è îïöèé ìîäóëÿ
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        'öèêë ïî âñåì ñòðîêàì êîäà âíóòðè ìîäóëÿ
        For li = lStartLine To lCountLines
            'ïîëó÷àåì èìÿ ïðîöåäóðû/ôóíêöèè, âíóòðè êîòîðîé ñòðîêà êîäà
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'åñëè èìÿ ïðîöåäóðû ñîâïàäàåò ñ òåì, êîòîðîå íàì íóæíî
            If sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change" Then
                'óçíàåì êîë-âî ñòðîê ïðîöåäóðû/ôóíêöèè
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'óäàëÿåì ïðîöåäóðó/ôóíêöèþ
                .CodeModule.DeleteLines li, lProcLineCount
                Exit For
            End If
            li = li + lProcLineCount
        Next li
    End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12

        For li = lCountLines To lStartLine Step -1
            'получаем имя процедуры/функции, внутри которой строка кода
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'если имя процедуры совпадает с тем, которое нам нужно
            If sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change" Then
                'узнаем кол-во строк процедуры/функции
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'удаляем процедуру/функцию
                .CodeModule.DeleteLines li, lProcLineCount
                Exit For
            End If
        Next li

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

Sub red_r()
Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents("Ëèñò1")
        'ïîëó÷àåì êîë-âî ñòðîê êîäà â ìîäóëå
        lCountLines = .CodeModule.CountOfLines
        'ïîëó÷àåì ïåðâóþ ñòðîêó ñ êîäîì, èñêëþ÷àÿ ñòðîêè äåêëàðèðîâàíèÿ ôóíêöèè è îïöèé ìîäóëÿ
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        'öèêë ïî âñåì ñòðîêàì êîäà âíóòðè ìîäóëÿ
         For li = lCountLines To lStartLine Step -1
            'ïîëó÷àåì èìÿ ïðîöåäóðû/ôóíêöèè, âíóòðè êîòîðîé ñòðîêà êîäà
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'åñëè èìÿ ïðîöåäóðû ñîâïàäàåò ñ òåì, êîòîðîå íàì íóæíî
            If sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change" Then
                'óçíàåì êîë-âî ñòðîê ïðîöåäóðû/ôóíêöèè
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'óäàëÿåì ïðîöåäóðó/ôóíêöèþ
                .CodeModule.DeleteLines li, lProcLineCount
                Exit For
            End If
        Next li
    End With
End Sub

1

sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change"

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

Sub red_r()
Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents("Ëèñò1")
        
        lCountLines = .CodeModule.CountOfLines
       
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        
         For li = lCountLines To lStartLine Step -1
           
            sProcName = .CodeModule.ProcOfLine(li, 0)
          
            If sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change" Then
              
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
               
                .CodeModule.DeleteLines li, lProcLineCount
                
            End If
        Next li
    End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Function Del_Proc(sCompName As String, sProcForDelName As String)
    Dim lCountLines As Long, li As Long, lStartLine As Long, lProcLineCount As Long
    Dim sCodeName As String, sProcName As String
 
    With ActiveWorkbook.VBProject.VBComponents(sCompName)
        'получаем кол-во строк кода в модуле
        lCountLines = .CodeModule.CountOfLines
        'получаем первую строку с кодом, исключая строки декларирования функции и опций модуля
        lStartLine = .CodeModule.CountOfDeclarationLines + 1
        'цикл по всем строкам кода внутри модуля
        For li = lStartLine To lCountLines
            'получаем имя процедуры/функции, внутри которой строка кода
            sProcName = .CodeModule.ProcOfLine(li, 0)
            'если имя процедуры совпадает с тем, которое нам нужно
            If sProcName = sProcForDelName Then
                'узнаем кол-во строк процедуры/функции
                lProcLineCount = .CodeModule.ProcCountLines(sProcName, 0)
                'удаляем процедуру/функцию
                .CodeModule.DeleteLines li, lProcLineCount
                Exit For
            End If
            li = li + lProcLineCount
        Next li
    End With
End Function

1
2

    Call Del_Proc("Лист1", "Worksheet_BeforeDoubleClick")
    Call Del_Proc("Лист1", "Worksheet_Change")