Удалить макрос из листа

@Ermak27 · Регистрация: 16.01.2013

Студворк — интернет-сервис помощи студентам

Добрый день!
Есть макрос на Лист1 (Проба)

Visual Basic
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

Как с помощью макроса можно его удалить и сохранить книгу?

@Hugo121 · 06.02.2013, 17:37

Самое простое в новейших версиях - сохранить файл как xlsx.

@Ermak27 · 06.02.2013, 18:28 **[ТС]**

Hugo121, Я наверное не так написал, мне нужно с помощью макроса удалить этот код

Visual Basic
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

а потом сохранить автоматически

@Hugo121 · 06.02.2013, 18:41

Вы не написали, что это за Эксель.
Ну а я бы не мудрил, а просто сохранил файл без поддержки макросов - запишите такое сохранение рекордером, используйте.
Если конечно не на 2000/2003 сидите

@Ermak27 · 06.02.2013, 18:49 **[ТС]**

Hugo121, мне нужно обязательно удалить этот код с помощью макроса, у меня 2003

@Hugo121 · 06.02.2013, 19:09

Вот дилемма - тут в правилах нельзя давать ссылки на другие сайты, там же "Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора".
Не буду ничего нарушать!

@Ermak27 · 06.02.2013, 19:19 **[ТС]**

Hugo121, ты че [удалено]

@Hugo121 · 06.02.2013, 19:26

Ого!

Разговор окончен.

@Ermak27 · 06.02.2013, 19:38 **[ТС]**

Hugo121, спасибо что "помог"

@The_Prist · 07.02.2013, 10:03

Visual Basic
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" - это кодовое имя листа, а не то, что отображено на ярлычке. Его можно посмотреть либо из редактора, либо получить кодом:

Visual Basic
1
Activesheet.codename

@Ermak27 · 07.02.2013, 13:35 **[ТС]**

The_Prist, Спасибо большое за очередную поддержку, но я имею ввиду удалить не весь код в Лист1 а только

Visual Basic
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

@The_Prist · 07.02.2013, 13:40

Я Вам на другом форуме дал ссылку на статью. Там все расписано и Ваш случай так же упомянут. А Вам советую свои пожелания сразу нормально обозначать, не скупясь на слова и пояснения.

Visual Basic
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

@Ermak27 · 07.02.2013, 13:48 **[ТС]**

The_Prist, Вот я подправил код

Visual Basic
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

Он удалил но оставил

Visual Basic
1
2
Option Explicit
End Sub

как это тоже удалить?
И как поставить еще чтобы он второй код удалял?

@The_Prist · 07.02.2013, 17:31

По первому вопросу:

Visual Basic
1
.CodeModule.DeleteLines li, lProcLineCount - 1

заменить на

Visual Basic
1
.CodeModule.DeleteLines li, lProcLineCount

по второму:

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

Пора бы уже...

Может имеет смысл уже начать изучать синтаксис? Хотя бы начало, что ли. В статье даже написано как определяется имя процедуры. Осталось лишь дополнить конструкцию If ... Then. Но без базовых знаний Вы, естественно, не можете этого сделать, т.к. даже не предполагаете где это делать. Это плохо. Форумы предназначены все же для помощи в изучении, а не для решения чужих задач.

@Ermak27 · 08.02.2013, 08:57 **[ТС]**

Спасибо большое, я пишу на 1С, я предполагал что нужно and или or ставить но не получилось оказало что нужно sProcName = "имя другой процедуры"

Добавлено через 13 часов 55 минут
The_Prist, Почему то второй не удалил код

Visual Basic
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

@The_Prist · 08.02.2013, 10:21

Попробуйте цикл организовать снизу вверх:

Visual Basic
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

@Ermak27 · 08.02.2013, 10:28 **[ТС]**

The_Prist, Все равно не удаляет

Visual Basic
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

@The_Prist · 08.02.2013, 10:49

Ну да. И Exit For уберите из цикла.

@Ermak27 · 08.02.2013, 11:23 **[ТС]**

The_Prist, Теперь он удаляет весь код кроме

Visual Basic
1
sProcName = "Worksheet_BeforeDoubleClick" Or sProcName = "Worksheet_Change"

Visual Basic
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

@The_Prist · 08.02.2013, 11:54

в принципе-то да...знаете что. Лучше это в виде функции оформите с передачей в качестве параметра имени функции(и имени компонента для универсальности). И все.

Visual Basic
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

и вызывайте её два раза:

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

ну или сколько Вам там еще процедур надо удалить.

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .
Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .	Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .

Удалить макрос из листа

Решение

Решение

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	06.02.2013, 17:37
	Самое простое в новейших версиях - сохранить файл как xlsx. 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	06.02.2013, 18:41
	Вы не написали, что это за Эксель. Ну а я бы не мудрил, а просто сохранил файл без поддержки макросов - запишите такое сохранение рекордером, используйте. Если конечно не на 2000/2003 сидите 1

@Ermak27 4 / 4 / 0 Регистрация: 16.01.2013 Сообщений: 1,228
	06.02.2013, 18:49 [ТС]
	Hugo121, мне нужно обязательно удалить этот код с помощью макроса, у меня 2003 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	06.02.2013, 19:09
	Вот дилемма - тут в правилах нельзя давать ссылки на другие сайты, там же "Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора". Не буду ничего нарушать! 0

@Ermak27 4 / 4 / 0 Регистрация: 16.01.2013 Сообщений: 1,228
	06.02.2013, 19:19 [ТС]
	Hugo121, ты че [удалено] 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	06.02.2013, 19:26
	Сообщение было отмечено как решение Решение Ого! Разговор окончен. 0

@Ermak27 4 / 4 / 0 Регистрация: 16.01.2013 Сообщений: 1,228
	06.02.2013, 19:38 [ТС]
	Hugo121, спасибо что "помог" 0

@The_Prist 2044 / 475 / 132 Регистрация: 13.11.2008 Сообщений: 909
	08.02.2013, 10:49
	Ну да. И Exit For уберите из цикла. 1