Удаление кода при копирование листа

@TXP · Регистрация: 27.05.2013

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

Доброго времени суток.
Помогите пожалуйста решить следующую проблему.
Имеется лист "Деталировка" на котором находится несколько элементов "Image" и кнопка "CBut11", необходимо что бы при нажатии кнопки были осуществлены следующие действия:
1. создавалась копия листа "Деталировка";
2. на копии листа "Деталировка" удалялась кнопка "CBut11";
3. так же на копии листа "Деталировка" должен быть удален код
4. лист переименовывается в соответствии со значением указанным в ячейке"А1".

В принципе с п.п. 1,2,4 как бы сам справился

Visual Basic
1
2
3
4
5
Private Sub CBut11_Click()
Sheets("Деталировка").Copy After:=Sheets(6)
ActiveSheet.Shapes.Range(Array("CBut11")).Delete
Sheets("Деталировка (2)").Name = Range("A1")
End Sub

загвоздка в п. 3 тут как бы я вижу два варианта решения: удалить код программно на скопированном листе либо осуществлять копирование без кодов, но как их реализовать я не знаю.
Так как сам в программирование не в зуб ногой, буду при много благодарен за готовое решение.

@sulfur · 28.05.2013, 00:35

а что вы называете кодом?

@TXP · 28.05.2013, 01:18 **[ТС]**

Сообщение от sulfur

а что вы называете кодом?

вот это

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Sub CBut11_Click()
Sheets("Деталировка").Copy After:=Sheets(6)
ActiveSheet.Shapes.Range(Array("CBut11")).Delete
Sheets("Деталировка (2)").Name = Range("A1")
End Sub
 
Private Sub Worksheet_Activate()
    Range("S1:V1").Value = Sheets("Расчет").Range("M21:P21").Value
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
      
  If Not Intersect(Target, Me.Range("S1")) Is Nothing Then
        Image1.Picture = LoadPicture("I:\Эскизы\" & Me.Range("S1").Value & ".jpg")
  End If
    If Me.Range("T1").Value > 0 Then
       Image2.Picture = LoadPicture("I:\Эскизы\" & Me.Range("T1").Value & ".jpg")
       Rows("21:36").EntireRow.Hidden = False
       Image2.Height = 142.5
       Image2.Width = 457.5
       Image2.Top = 316.5
       Image2.Left = 0.75
       
    Else
        Image2.Picture = LoadPicture("")
        Rows("21:36").EntireRow.Hidden = True
    End If
    
    If Range("U1").Value = 0 Then
       Image3.Picture = LoadPicture("I:\Эскизы\13.jpg")
    Else
       Image3.Picture = LoadPicture("I:\Эскизы\11.jpg")
    End If
    
    If Range("V1").Value = 0 Then
       If Range("U1").Value = 0 Then
          Image4.Picture = LoadPicture("")
          Range("J40:K43").Borders.LineStyle = xlNone
       Else
          Image4.Picture = LoadPicture("I:\Эскизы\13.jpg")
          Range("J40:K43").Borders.LineStyle = xlContinuous
       End If
    
    Else
       Image4.Picture = LoadPicture("I:\Эскизы\12.jpg")
       Range("J40:K43").Borders.LineStyle = xlContinuous
    End If
    
    If Range("U1").Value = 0 Then
       Image5.Picture = LoadPicture("")
       Range("O40:P42").Borders.LineStyle = xlNone
    Else
       If Range("V1").Value = 0 Then
          Image5.Picture = LoadPicture("")
          Range("O40:P42").Borders.LineStyle = xlNone
       Else
          Image5.Picture = LoadPicture("I:\Эскизы\13.jpg")
          Range("O40:P42").Borders.LineStyle = xlContinuous
       End If
       
    End If
End Sub

@SlavaRus · 28.05.2013, 08:17

3. так же на копии листа "Деталировка" должен быть удален код

А писать код в модуле листа есть веские причины? Можно написать код в обычном модуле и ничего не придетсся удалять после копирования листа.

@TXP · 28.05.2013, 09:01 **[ТС]**

Сообщение от SlavaRus

А писать код в модуле листа есть веские причины? Можно написать код в обычном модуле и ничего не придетсся удалять после копирования листа.

Да я честно признаться и не знал что можно писать в обычном модуле, да и как писать тоже не знаю, если не затруднит на пишите пожалуйста пример на основании данной операции

Visual Basic
1
2
3
Private Sub Worksheet_Activate()
    Range("S1:V1").Value = Sheets("Расчет").Range("M21:P21").Value
End Sub

.

@sulfur · 28.05.2013, 09:09

TXP, удалить код в модуле листа Лист1 вот так:

Visual Basic
1
2
3
StartLine = 1
EndLine = ThisWorkbook.VBProject.VBComponents("Лист1").CodeModule.CountOfLines
ThisWorkbook.VBProject.VBComponents("Лист1").CodeModule.DeleteLines StartLine, (EndLine - StartLine)

SlavaRus, если код записать в модуле, то он не будет срабатывать по событиям Worksheet_Activate, Worksheet_Change

@SlavaRus · 28.05.2013, 09:36

Сообщение от TXP

Да я честно признаться и не знал что можно писать в обычном модуле, да и как писать тоже не знаю, если не затруднит на пишите пожалуйста пример на основании данной операции

Visual Basic
1
2
3
Private Sub Worksheet_Activate()
    Range("S1:V1").Value = Sheets("Расчет").Range("M21:P21").Value
End Sub

.

Нажми на кнопку, после этого в обработчике события будут копироваться данные.

@TXP · 28.05.2013, 10:07 **[ТС]**

[QUOTE=sulfur;4628162]TXP, удалить код в модуле листа Лист1 вот так:

Visual Basic
1
2
3
StartLine = 1
EndLine = ThisWorkbook.VBProject.VBComponents("Лист1").CodeModule.CountOfLines
ThisWorkbook.VBProject.VBComponents("Лист1").CodeModule.DeleteLines StartLine, (EndLine - StartLine)

а как правильно задать что бы код удалялся с диапазона листов (например с "Лист6" и далее), а то у меня удаляется код на "Лист6" а на "Лист7" и последующих остается

@sulfur · 28.05.2013, 10:13

TXP, удаляем код при нажатии на кнопку (после копирования листа)

Visual Basic
1
2
3
4
5
6
7
8
Private Sub CBut11_Click()
Sheets("Деталировка").Copy After:=Sheets(6)
ActiveSheet.Shapes.Range(Array("CBut11")).Delete
Sheets("Деталировка (2)").Name = Range("A1")
StartLine = 1
EndLine = ThisWorkbook.VBProject.VBComponents(Range("A1")).CodeModule.CountOfLines
ThisWorkbook.VBProject.VBComponents(Range("A1")).CodeModule.DeleteLines StartLine, (EndLine - StartLine)
End Sub

@TXP · 28.05.2013, 10:37 **[ТС]**

Ран тайм еррор 9 Subscript out of range ругается

@sulfur · 28.05.2013, 10:48

TXP, на какой строке? Вообще лучше скиньте документ

@TXP · 28.05.2013, 12:00 **[ТС]**

Вот
Болты v.1.3.5.xlsm.7z
отправил без картинок

@Pavel55 · 28.05.2013, 12:25

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub CBut11_Click()
    Dim StartLine&, EndLine&
    Application.EnableEvents = False
    Sheets("Деталировка").Copy After:=Worksheets(Sheets.Count)
    Application.EnableEvents = True
    ActiveSheet.Shapes.Range(Array("CBut11")).Delete
    ActiveSheet.Name = Range("A1")
    StartLine = 1
    EndLine = ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule.CountOfLines
    ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule.DeleteLines StartLine, (EndLine - StartLine + 1)
End Sub

@TXP · 28.05.2013, 14:26 **[ТС]**

Всем спасибо

@Kubuntovod · 21.07.2014, 15:54

Кто-нибудь, объясните плиз, как избавиться орт следующих граблей. С помощью вышеуказанного решения удаляется код листа. Затем:

Visual Basic
1
2
ActiveWorkbook.SaveAs namefile
ActiveWorkbook.Close

Но при открытии полученного файла, появляется сообщение, что в книге содержится макрос. Все места с кодом девственно чисты. Причём, если открыть файл и тут же его сохранить, ничего не изменяя в нём, то в последующем сообщение о макросах уже не выходит. Как же их (макросы) удалить окончательно и бесповоротно?

Excel 2003

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Programma_Boinc 01.01.2026 Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. 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? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .

@sulfur 200 / 98 / 2 Регистрация: 24.09.2011 Сообщений: 261
	28.05.2013, 00:35
	а что вы называете кодом? 0

@TXP 0 / 0 / 0 Регистрация: 27.05.2013 Сообщений: 14
	28.05.2013, 10:37 [ТС]
	Ран тайм еррор 9 Subscript out of range ругается 0

@sulfur 200 / 98 / 2 Регистрация: 24.09.2011 Сообщений: 261
	28.05.2013, 10:48
	TXP, на какой строке? Вообще лучше скиньте документ 0

@TXP 0 / 0 / 0 Регистрация: 27.05.2013 Сообщений: 14
	28.05.2013, 12:00 [ТС]
	Вот Болты v.1.3.5.xlsm.7z отправил без картинок 0

@TXP 0 / 0 / 0 Регистрация: 27.05.2013 Сообщений: 14
	28.05.2013, 14:26 [ТС]
	Всем спасибо 0