Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Программно создать лист с событийным макросом
 
#1
29.04.2026 15:28:23
Коллеги, назрел вопрос, и не могу нагуглить релевантный ответ.
Озадачился проблемой создания в текущей книге нового листа со встроенным событийным макросом на двойной клик по любой ячейке:
Код
Private Sub make_prot()
Set wb = ThisWorkbook ' alias

DA = Application.DisplayAlerts
Application.DisplayAlerts = False
For Each sh In wb.Sheets
    If sh.Name = "ПРОТОКОЛ" Then sh.Delete ' убили старый протокол
Next
Application.DisplayAlerts = DA

Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(after:=Sheets("ОТЧЕТ")) ' лист пересоздали.
ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
'
' тут пока неважно... пока всё хорошо
'
' а тут начинается интересное
Set prj = ThisWorkbook.VBProject
Set cmp = prj.VBComponents(ptr.CodeName)
 
With cmp.CodeModule
    lm = .CreateEventProc("BeforeDoubleClick", "Worksheet")
    .InsertLines lm + 1, "Cancel = True"
    .InsertLines lm + 2, "msgbox ""лист создан"""
    ' и т.д.
End With
   
End Sub
В теории всё должно работать. Но sub завершается ошибкой 424 "Object required", хотя новый лист создается, и макрос на нем прописывается как задумано. А на экране остается открытое окно VBE с только что созданной процедурой Worksheet_BeforeDoubleClick() - вот этого  вообще не ожидал.

Короче, вопросы:
1. Как уйти от ошибки 424?
2. Как скрыть в конце окно VBE от пользователя?
3. Почему, если прописать два оператора set в одну строку:
Код
Set cmp = ThisWorkbook.VBProject.VBComponents(ptr.CodeName)
(переменная prj больше нигде не используется), то при выполнении на этой строке вылезет 9 "Subscript out of range", но если уйти в Debug и шагать по F8 - макрос работает до самого конца, до ошибки 424 (см. выше).

Можно конечно не удалять существующий лист, а просто очистить. Но тут уже дело принципа, хочется разобраться с тонкостями.
Что я упускаю?
 
 
 
#2
29.04.2026 15:45:10
А Вы как make_prot вызываете? Из другой процедуры?
У меня этот вариант не приводит к ошибке.
Код
Sub make_prot()
    Const PROT_NAME = "ПРОТОКОЛ"

    Dim wb As Workbook
    Set wb = ThisWorkbook ' alias
     
'    DA = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets(PROT_NAME).Delete ' убили старый протокол
    On Error GoTo 0
    Application.DisplayAlerts = True
     
    Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(After:=wb.Sheets("ОТЧЕТ")) ' лист пересоздали.
    ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
    '
    ' тут пока неважно... пока всё хорошо
    '
    ' а тут начинается интересное
    Dim prj As Object, cmp As Object
    Set prj = wb.VBProject
    Set cmp = prj.VBComponents(ptr.CodeName)
      
    With cmp.CodeModule
        Dim lm As Long
        lm = .CreateEventProc("BeforeDoubleClick", "Worksheet")
        .InsertLines lm + 1, "Cancel = True"
        .InsertLines lm + 2, "msgbox ""лист создан"""
        ' и т.д.
    End With
    
End Sub
 
 
 
#3
29.04.2026 15:57:59
Цитата
написал:
А Вы как make_prot вызываете? Из другой процедуры?
Совершенно верно, данный private sub вызывается (буквально первой строкой) из другого [public] sub в этом же модуле. И этот "другой" sub повешен на экранную кнопку, которую нажимает юзер. Вроде всё как обычно...

Принципиальных разниц в моем и Вашем коде не нашел, разве что объявления "Dim prj As Object, cmp As Object".
Может все мои вопросы связаны с версией самого Excel? У нас старинный 2007, и любые более новые запрещены корпоративной политикой.
 
 
 
#4
29.04.2026 15:59:02
Ещё вариант.
Код
Sub make_prot()
'v2
    Const PROT_NAME = "ПРОТОКОЛ"
    
    Dim wb As Workbook
    Set wb = ThisWorkbook ' alias
     
'    DA = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets(PROT_NAME).Delete ' убили старый протокол
    On Error GoTo 0
    Application.DisplayAlerts = True
     
    Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(After:=wb.Sheets("ОТЧЕТ")) ' лист пересоздали.
    ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
    '
    ' тут пока неважно... пока всё хорошо
    '
    ' а тут начинается интересное
    Dim prj As Object, cmp As Object
    Set prj = wb.VBProject
    Set cmp = prj.VBComponents(ptr.CodeName)
      
    cmp.CodeModule.CreateEventProc "BeforeDoubleClick", "Worksheet"
    Dim lm As Long
    lm = cmp.CodeModule.ProcStartLine("Worksheet_BeforeDoubleClick", 0) + 2
    With cmp.CodeModule
        .InsertLines lm, "Cancel = True"
        .InsertLines lm, "MsgBox ""Ты дважды кликнул."", vbInformation, ""Капитан очевидность сообщает..."""
    End With
End Sub
 
 
 
#5
29.04.2026 16:07:19
Цитата
написал:
2. Как скрыть в конце окно VBE от пользователя?
Light версия, с морганием.
Код
Sub make_prot()
'v3
    Const PROT_NAME = "ПРОТОКОЛ"
    
    Dim wb As Workbook
    Set wb = ThisWorkbook ' alias
     
'    DA = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets(PROT_NAME).Delete ' убили старый протокол
    On Error GoTo 0
    Application.DisplayAlerts = True
     
    Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(After:=wb.Sheets("ОТЧЕТ")) ' лист пересоздали.
    ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
    '
    ' тут пока неважно... пока всё хорошо
    '
    ' а тут начинается интересное
    Dim cmp As Object
    Set cmp = wb.VBProject.VBComponents(ptr.CodeName)
      
    cmp.CodeModule.CreateEventProc "BeforeDoubleClick", "Worksheet"
    Dim lm As Long
    lm = cmp.CodeModule.ProcStartLine("Worksheet_BeforeDoubleClick", 0) + 2
    With cmp.CodeModule
        .InsertLines lm, "Cancel = True"
        .InsertLines lm, "MsgBox ""Ты дважды кликнул."", vbInformation, ""Капитан очевидность сообщает..."""
    End With
    
    Application.VBE.MainWindow.Visible = False
End Sub
 
 
 
#6
29.04.2026 16:10:21
Цитата
Application.VBE.MainWindow.Visible = False

Уже спасибо, один вопрос решен. Остальное проверяю.
 
 
 
#7
29.04.2026 16:13:49
Без ошибки 9 "Subscript out of range".
Код
Sub make_prot()
'v4
    Const PROT_NAME = "ПРОТОКОЛ"
    
    Dim wb As Workbook
    Set wb = ThisWorkbook ' alias
    
    Dim DA As Boolean
    DA = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets(PROT_NAME).Delete ' убили старый протокол
    On Error GoTo 0
    Application.DisplayAlerts = DA
     
    Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(After:=wb.Sheets("ОТЧЕТ")) ' лист пересоздали.
    ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
    '
    ' тут пока неважно... пока всё хорошо
    '
    ' а тут начинается интересное
    Dim cmp As Object
    Application.VBE.MainWindow.Visible = True
    Set cmp = wb.VBProject.VBComponents(ptr.CodeName).CodeModule
      
    cmp.CreateEventProc "BeforeDoubleClick", "Worksheet"
    Dim lm As Long
    lm = cmp.ProcStartLine("Worksheet_BeforeDoubleClick", 0) + 2
    cmp.InsertLines lm, "Cancel = True"
    cmp.InsertLines lm, "MsgBox ""Ты дважды кликнул."", vbInformation, ""Капитан очевидность сообщает..."""
    
    Application.VBE.MainWindow.Visible = False
End Sub
 
 
 
#8
29.04.2026 16:28:35
Ещё не всё, но что-то начинаю понимать.

Если шагать данный макрос по F8, на строчке    lm = .CreateEventProc("BeforeDoubleClick", "Worksheet")  VBA выплевывает ошибку, см приложенный скриншот.

А при нормальном выполнении данной ошибки нет, но мы проваливаемся в другой модуль - на только что созданный лист. И по ходу теряем управление выполняющимся макросом.  Если нажать Continue, открывается VBE с кодом нового листа. Необходимо вручную вернуться в выполняющийся модуль, и дошагать его до конца.
Новый вопрос: как программно переключиться к текущему модулю, после создания чего-то нового?
Изменено: Alexcx - 29.04.2026 16:29:38
 
 
 
#9
29.04.2026 16:38:23
Цитата
написал:
Новый вопрос: как программно переключиться к текущему модулю, после создания чего-то нового?
Какое амбициозное заявление :)))
Код
Sub make_prot()
    Const PROT_NAME = "ПРОТОКОЛ"
    
    Dim wb As Workbook
    Set wb = ThisWorkbook ' alias
    
    Dim DA As Boolean
    DA = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets(PROT_NAME).Delete ' убили старый протокол
    On Error GoTo 0
    Application.DisplayAlerts = DA
     
    Dim ptr As Worksheet: Set ptr = wb.Sheets.Add(After:=wb.Sheets("ОТЧЕТ")) ' лист пересоздали.
    ptr.Name = "ПРОТОКОЛ": ptr.Cells.NumberFormat = "@"
    '
    ' тут пока неважно... пока всё хорошо
    '
    ' а тут начинается интересное
    Dim cmp As Object
    'Application.VBE.MainWindow.Visible = True
    With wb.VBProject.VBComponents: End With
    Set cmp = wb.VBProject.VBComponents(ptr.CodeName).CodeModule
      
    cmp.CreateEventProc "BeforeDoubleClick", "Worksheet"
    Dim lm As Long
    lm = cmp.ProcStartLine("Worksheet_BeforeDoubleClick", 0) + 2
    cmp.InsertLines lm, "Cancel = True"
    cmp.InsertLines lm, "MsgBox ""Ты дважды кликнул."", vbInformation, ""Капитан очевидность сообщает..."""
    
    Application.VBE.MainWindow.Visible = False
    VBEshow "make_prot"
End Sub

Sub VBEshow(ProcName As String, Optional ByRef wb As Workbook = Nothing)
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    Application.WindowState = xlMinimized
    Application.VBE.MainWindow.Visible = True
    Application.VBE.MainWindow.SetFocus
    
    Dim Component As Object
    
    For Each Component In wb.VBProject.VBComponents
        With Component.CodeModule
            On Error Resume Next
                With .ProcStartLine(ProcName, 0): End With
                If Err = 0 Then
                    .CodePane.Show
                    .CodePane.SetSelection .ProcBodyLine(ProcName, 0), 1, .ProcBodyLine(ProcName, 0) + 1, 1 ' _
                                            '.ProcStartLine(ProcName, 0) + .ProcCountLines(ProcName, 0), 1  'Выделить всю процедуру
                    Exit Sub
                End If
            On Error GoTo 0
        End With
    Next
End Sub
 
 
 
#10
30.04.2026 09:20:24
Читерский вариант, менее интеллектуальный и настолько же менее трудоёмкий:
- создать шаблон листа с уже прописанной процедурой обработки события
- при необходимости скрыть его
- когда понадобится создать лист, просто скопировать шаблон.
 
 
 
#11
30.04.2026 09:29:22
Еще более крутой вариант, раз все в пределах одной книги(ThisWorkdook): разместить коды в ЭтаКнига с определением имени листа. Все! :)

P.S. Если честно, вообще не вижу смысла в замене кодов кодами в той же книге, в которой сам код. Ведь этот код надо самому писать. Зачем эти манипуляции? Если бы замена производилась в других книгах - я еще понимаю, бывает так. И то не в листах, а в ЭтаКнига. Все остальное либо копирование листа с кодом целиком, либо экспорт(.Export, а не InsertLines), если речь о стандартных модулях. Если из исходного листа надо переносить все данные на листе - это тоже делается при помощи переноса ячеек после копирования листа в целевую книгу. Это куда надежнее внесений изменений в проект построчно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Читают тему
Наверх