Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как добавить код процедуры программно, скопировать модуль

Бывают ситуации, когда кодом создается книга, в нее опять же кодом заносятся данные. И порой необходимо помимо всего прочего добавить в новую книгу и код VBA. Естественно, тоже программно. На самом деле это совсем не сложно.

Для изменения кодов программно необходимо, чтобы было проставлено доверие к объектной модели проекта VBA и изменяемый проект не должен быть защищен. Подробнее читайте в статье: Что необходимо для внесения изменений в проект VBA(макросы) программно
Без этого будет невозможно программное вмешательство в проект VBA.

В данной статье я покажу как программно выполнить следующее:

Так же приведена функция, которая копирует указанный модуль из одной книги в другую.
Как копировать, экспортировать и импортировать модули вручную описано в этой статье


 
Теперь перейдем непосредственно к сути. Сначала рассмотрим добавление в проект стандартного модуля.
Для добавления стандартного модуля и кода в нем можно воспользоваться двумя методами:

  1. Экспорт имеющегося модуля(с процедурами) из книги с кодом в новую книгу. Чаще всего применяется когда кодов для записи в новую книгу довольно много и создавать их все, прописывая в коде, весьма неудобно и громоздко;
  2. Создание нового модуля и запись необходимых кодов в него. Применяется, если необходимо создать относительно короткие процедуры в модуле.


 
1. ЭКСПОРТ ИМЕЮЩЕГОСЯ МОДУЛЯ

Sub Copy_Module()
    Dim objVBProjFrom As Object, objVBProjTo As Object, objVBComp As Object
    Dim sModuleName As String, sFullName As String
    'расширение стандартного модуля
    Const sExt As String = ".bas"
 
    'имя модуля для копирования
    sModuleName = "Module1"
    On Error Resume Next
    'проект книги, из которой копируем модуль
    Set objVBProjFrom = ThisWorkbook.VBProject
    'необходимый компонент
    Set objVBComp = objVBProjFrom.VBComponents(sModuleName)
    'если указанного модуля не существует
    If objVBComp Is Nothing Then
        MsgBox "Модуль с именем '" & sModuleName & "' отсутствует в книге.", vbCritical, "Error"
        Exit Sub
    End If
    'проект книги для добавления модуля
    Set objVBProjTo = ActiveWorkbook.VBProject
    'полный путь для экспорта/импорта модуля. К папке должен быть доступ на запись/чтение
    sFullName = "C:\" & sModuleName & sExt
    objVBComp.Export Filename:=sFullName
    objVBProjTo.VBComponents.Import Filename:=sFullName
    'удаляем временный файл для импорта
    Kill sFullName
End Sub

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


 
2. СОЗДАНИЕ НОВОГО МОДУЛЯ

Sub Create_NewModule()
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim sModuleName As String, sFullName As String
    Dim sProcLines As String
    Dim lLineNum As Long
 
    'добавляем новый стандартный модуль в активную книгу
    Set objVBComp = ActiveWorkbook.VBProject.VBComponents.Add(1)
    'получаем ссылку на коды модуля
    Set objCodeMod = objVBComp.CodeModule
    'узнаем количество строк в модуле
    '(т.к. VBA в зависимости от настроек может добавлять строки деклараций)
    lLineNum = objCodeMod.CountOfLines + 1
    'текст всставляемой процедуры
    sProcLines = "Sub Test()" & vbCrLf & _
        "    MsgBox ""Hello, World""" & vbCrLf & _
        "End Sub"
    'вставляем текст процедуры в тело нового модуля
    objCodeMod.InsertLines lLineNum, sProcLines
End Sub

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

Sub Test()
    MsgBox "Hello, World"
End Sub


 
 
CОЗДАНИЕ СОБЫТИЙНЫХ ПРОЦЕДУР
Помимо стандартных процедур, имеется возможность добавить и событийные(изменения на листе, открытие книги и т.п.). Я приведу примеры создания кода:

  • в Лист1 на изменении данных ячейки в новой книге
  • в ЭтаКнига(ThisWorkbook) на событие открытия книги.

На их основе уже можно будет понять как создать другие событийные процедуры.
 
CОЗДАНИЕ СОБЫТИЙНОЙ ПРОЦЕДУРЫ Worksheet_Change в Лист1

Sub CreateEventProcedure_WorkSheetChange()
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long
    'добавляем новую книгу
    Workbooks.Add
    'получаем ссылку на проект и модуль листа
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("Лист1")
    Set objCodeMod = objVBComp.CodeModule
    'вставляем код
    With objCodeMod
        lLineNum = .CreateEventProc("Change", "Worksheet")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "    MsgBox ""Hello World"""
    End With
End Sub

Важно: для русской версии используется ссылка на Лист1. Для английской как правило Sheet1

Set objVBComp = objVBProj.VBComponents("Sheet1")

 
 
CОЗДАНИЕ СОБЫТИЙНОЙ ПРОЦЕДУРЫ Workbook_Open

Sub CreateEventProcedure()
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long
    'добавляем новую книгу
    Workbooks.Add
    'получаем ссылку на проект и модуль книги
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("ЭтаКнига")
    Set objCodeMod = objVBComp.CodeModule
    'вставляем код
    With objCodeMod
        lLineNum = .CreateEventProc("Open", "Workbook")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "    MsgBox ""Hello World"""
    End With
End Sub

Важно: для русской версии используется ссылка на ЭтаКнига. Для английской ThisWorkbook

Set objVBComp = objVBProj.VBComponents("ThisWorkbook")

 
 
Функция CopyVBComponent
ПОЗВОЛЯЕТ КОПИРОВАТЬ ЛЮБОЙ КОМПОНЕНТ ИЗ ОДНОЙ КНИГИ В ДРУГУЮ

'---------------------------------------------------------------------------------------
' Procedure : CopyVBComponent
' DateTime  : 02.08.2013 23:10
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция копирует компонент из одной книги в другую.
'             Возвращает True, если копирование прошло удачно
'             False - если компонент не удалось скопировать
'
' wbFromFrom             Книга, компонент из VBA-проекта которой необходимо копировать
'
' wbFromTo               Книга, в VBA-проект которой необходимо копировать компонент
'
' sModuleName            Имя модуля, который необходимо копировать.
'
' sModuleToName          Имя модуля, в который необходимо копировать.
'
' bOverwriteExistModule  Если True или 1, то при наличии в конечной книге
'                        компонента с именем sModuleName - он будет удален,
'                        а вместо него импортирован копируемый.
'                        Если False, то при наличии в конечной книге
'                        компонента с именем sModuleName функция вернет False,
'                        а сам компонент не будет скопирован.
'---------------------------------------------------------------------------------------
Function CopyVBComponent(sModuleName As String, ByVal sModuleToName As String, _
    wbFromFrom As Workbook, wbFromTo As Workbook, _
    bOverwriteExistModule As Boolean) As Boolean
 
    Dim objVBProjFrom As Object, objVBProjTo As Object
    Dim objVBComp As Object, objTmpVBComp As Object
    Dim sTmpFolderPath As String, sVBCompName As String, sModuleCode As String
 
    'Проверяем корректность указанных параметров
    On Error Resume Next
    Set objVBProjFrom = wbFromFrom.VBProject
    Set objVBProjTo = wbFromTo.VBProject
 
    'если в книге, из которой копируем нет проекта VBA
    If objVBProjFrom Is Nothing Then
        CopyVBComponent = False: Exit Function
    End If
    'если в книге, из которой копируем для проекта VBA установлен пароль
    If objVBProjFrom.Protection = 1 Then
        CopyVBComponent = False: Exit Function
    End If
 
    'если в книге, в которую копируем нет проекта VBA
    If objVBProjTo Is Nothing Then
        CopyVBComponent = False: Exit Function
    End If
    'если в книге, в которую копируем для проекта VBA установлен пароль
    If objVBProjTo.Protection = 1 Then
        CopyVBComponent = False: Exit Function
    End If
 
    'если не задано имя копируемого модуля
    If Trim(sModuleName) = "" Then
        CopyVBComponent = False: Exit Function
    End If
    'если не задано имя модуля для вставки кода - используем имя копируемого
    If Trim(sModuleName) = "" Then
        sModuleToName = sModuleName
    End If
 
    'проверяем, существует ли в книге из которой копируем заданный модуль
    Set objVBComp = objVBProjFrom.VBComponents(sModuleName)
    'модуля нет - выходим из функции
    If objVBComp Is Nothing Then
        CopyVBComponent = False: Exit Function
    End If
 
    '====================================================
    'полный путь для экспорта/импорта модуля. К папке должен быть доступ на запись/чтение
    sTmpFolderPath = Environ("Temp") & "\" & sModuleToName & ".bas" '"
    If bOverwriteExistModule = True Then
        ' Если bOverwriteExistModule = True
        ' удаляем из временной папки и из конечного проекта
        ' модуль с указанным именем
        If Dir(sTmpFolderPath, 6) <> "" Then
            Err.Clear
            Kill sTmpFolderPath
            'удалить не удалось, модуль не сохранен. Выход из функции
            If Err.Number <> 0 Then
                CopyVBComponent = False: Exit Function
            End If
        End If
        'удаляем модуль из конечной книги
        With objVBProjTo.VBComponents
            Set objVBComp = Nothing
            Set objVBComp = .Item(sModuleToName)
            'только если это не модуль листа или книги(их можно только очистить, но не удалять)
            If objVBComp.Type <> 100 Then
                .Remove .Item(sModuleToName)
            End If
        End With
    Else
        Err.Clear
        Set objVBComp = objVBProjTo.VBComponents(sModuleToName)
        If Err.Number <> 0 Then
            'Err.Number 9 - отсутствие указанного компонента, что нам не мешает.
            'Если ошибка другая - выход из функции
            If Err.Number <> 9 Then
                CopyVBComponent = False: Exit Function
            End If
        End If
    End If
 
    '====================================================
    'Экспорт/Импорт компонента во временную директорию
    objVBProjFrom.VBComponents(sModuleName).Export sTmpFolderPath
    '====================================================
    'копируем
    Set objVBComp = Nothing
    Set objVBComp = objVBProjTo.VBComponents(sModuleToName)
    If objVBComp Is Nothing Then
        objVBProjTo.VBComponents.Import sTmpFolderPath
    Else
        'Если компонент - модуль листа или книги -
        'его нельзя удалить. Поэтому удаляем из него весь код
        'и добавляем код из копируемого компонента
        If objVBComp.Type = 100 Then
            'для простоты обращения в коде - делаем ссылку на копируемый модуль
            Set objTmpVBComp = objVBProjFrom.VBComponents(sModuleName)
            'копируем из него код
            With objVBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                sModuleCode = objTmpVBComp.CodeModule.Lines(1, objTmpVBComp.CodeModule.CountOfLines)
                .InsertLines 1, sModuleCode
            End With
        End If
    End If
    'удаляем временный файл компонента
    Kill sTmpFolderPath
    CopyVBComponent = True
End Function

Пример вызова функции CopyVBComponent
Обычные модули, модули классов и форм(если в конечной книге надо использовать то же имя модуля, что и у копируемого модуля):

Sub CopyComponent()
    Workbooks.Add
    If CopyVBComponent("Module1", "", ThisWorkbook, ActiveWorkbook, True) Then
        MsgBox "Указанный компонент успешно скопирован в новую книгу", vbInformation
    Else
        MsgBox "Компонент не был скопирован", vbInformation
    End If
End Sub

Если необходимо копировать код из обычного модуля в модуль ЭтаКнига:

Sub CopyComponent()
    Workbooks.Add
    If CopyVBComponent("Module1", ActiveWorkbook.CodeName, ThisWorkbook, ActiveWorkbook, True) Then
        MsgBox "Указанный компонент успешно скопирован в новую книгу", vbInformation
    Else
        MsgBox "Компонент не был скопирован", vbInformation
    End If
End Sub

Приведенная функция так же может копировать коды и внутри одной книги: например, перенести код из стандартного модуля в модуль ЭтаКнига или модуль листа:

Sub CopyComponent()
    Workbooks.Add
    If CopyVBComponent("Module1", ThisWorkbook.CodeName, ThisWorkbook, ThisWorkbook, True) Then
        MsgBox "Указанный компонент успешно скопирован в новую книгу", vbInformation
    Else
        MsgBox "Компонент не был скопирован", vbInformation
    End If
End Sub

Думаю теперь у вас не должно возникнуть трудностей с переносом кодов из одной книги в другую.

Также см.:
Удалить макросы из книги
Как удалить макросы в книге?
Как программно снять пароль с VBA проекта?
Копирование модулей и форм из одной книги в другую


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 12 комментариев
  1. ioulka:

    прекрасная прога! спасибо большое! но! у меня возникла небольшая проблема пишет
    objVBProjFrom=nothing и выкидывает меня из процедуры (согласно вообщем то логике процедуры). не могу понять почему у меня objVBProjFrom=nothing равно как и objVBProjTo=nothing. Все вроде делаю как надо- задают workbook to & from... почему это может быть не подскажете?

  2. В самом начале статьи есть примечание со ссылкой на статью: Что необходимо для внесения изменений в проект VBA(макросы) программно

  3. ioulka:

    Спасибо огромное!!!! Все получилось! супер сайт и проги!

  4. СергейКр:

    Спасибо, Дмитрий
    Вопрос: при запуске макроса для "создания новых модулей и процедур" с загруженной UserForm (но, не уверен, что в этом причина) весь процесс "создания" появляется на экране (т.е. открывается VBA и визуально видно как все эти новые модули, формы, процедуры создаются). Как визуально скрыть процесс?
    Application.DisplayAlerts = False или Application.ScreenUpdating = False не помогает.

  5. MAGRAW:

    Добрый день.
    Пытаюсь пользовать ваш функционал. Столкнулся с проблемой.
    Что делаю:
    1) Копирую типовые листы из другой книги в рабочую. Никакого дополнительного кода импортируемые листы не содержат на момент копирования.
    2) Добавляю 2 события для импортированного листа

    Private Sub Worksheet_Activate()
    If VE.LoadData True Then Activate_CubeSheet ActiveSheet

    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If VE.LoadData True Then
    Set VE.iBook = ActiveWorkbook
    Set VE.iSheet = VE.iBook.ActiveSheet
    Set VE.iRange = Selection 'VE.iSheet.Selection

    VE.firstRange = GetStartLocationAddressRange(Selection)
    VE.endRange = GetEndLocationAddressRange(Selection)
    VE.shzoom = ActiveWindow.Zoom
    VE.SC = ActiveWindow.ScrollColumn
    VE.SR = ActiveWindow.ScrollRow

    VE.iBook.Worksheets("StdGiDNames").Range("H1") = VE.firstRange
    VE.iBook.Worksheets("StdGiDNames").Range("I1") = VE.endRange
    VE.iBook.Worksheets("StdGiDNames").Range("J1") = VE.shzoom
    VE.iBook.Worksheets("StdGiDNames").Range("K1") = VE.SC
    VE.iBook.Worksheets("StdGiDNames").Range("L1") = VE.SR
    End If

    End Sub

    Получаю ошибку "can't enter break mode at this time"
    Далее неприятно уже работать. Точки останова не работают.
    Application.DisplayAlerts = False - не помогает, как и прочие
    Application.Wait time:=Now + 1 / 10 ^ 9
    DoEvents

    Был бы признателен если бы вы подсказали как исключить этот конфликт.

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

  6. Paxani4:

    Очень полезная статься. У меня только вот такой нюансик. Я вставляю в лист событийную процедуру
    Call CreateEventProcedure_WorkSheetChange(SmetWb.Worksheets("Бухгалтерия"))

    'процедура добавления событийной процедуры на лист
    Sub CreateEventProcedure_WorkSheetChange(Sh As Worksheet)
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long
    Number = Sh.CodeName

    'получаем ссылку на проект и модуль листа
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents(Sh.CodeName)
    Set objCodeMod = objVBComp.CodeModule
    'вставляем код
    With objCodeMod
    Line = .CountOfLines
    If Line <= 1 Then ' если нет строк, то добавим процедуру
    lLineNum = .CreateEventProc("Change", "Worksheet")
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, " Call Gotovo_Change(Target)"
    End If
    End With
    End Sub

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

    • kix:

      Application.VBE.MainWindow.Visible = False

      • Евгений:

        Доброй ночи. А куда надо вставить этот кусок кода Application.VBE.MainWindow.Visible = False, чтобы окно vbe не открывалось при вставке в модуль листа событийной процедуры?.. пробовал в thisbook - не работает. помогите разобраться пожалста

        • Александр:

          Долго ковырялся в Нете по теме как победить всплывающее окно VBE при вставке кода в новый лист по событию Change. В итоге нашел, отладил, все работает )
          Ссылка на первоисточник: http://www.cpearson.com/Excel/vbe.aspx#ScreenFlicker

          Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                  (ByVal ClassName As String, ByVal WindowName As String) As Variant
          Declare PtrSafe Function LockWindowUpdate Lib "user32" _
                  (ByVal hWndLock As Long) As Variant
          Sub Название_вашего_макроса ()
                  Dim VBEHwnd As Long
                  On Error GoTo ErrH:
                  Application.VBE.MainWindow.Visible = False
                  VBEHwnd = FindWindow("wndclass_desked_gsk", _
                      Application.VBE.MainWindow.Caption)
           
                  If VBEHwnd Then
                      LockWindowUpdate VBEHwnd
                  End If
                 ' ДАЛЬШЕ ВАШ КОД
                 ...
                 ...
                 ...
                  Application.VBE.MainWindow.Visible = False
              ErrH:
                  LockWindowUpdate 0&
          End Sub

          Успехов! )
          P.S. у меня Win64 )

  7. Евгений:

    Спасибо за статью!
    Столкнулся с такой проблемой:
    Первоначальный код книги был подписан цифровой подписью. Есть ли возможность программного подписания модуля при внесении изменений?

  8. Дмитрий:

    ДД.
    Создаю новую книгу, вставляю в нее событийную процедуру Workbook_Open, сохраняю эту книгу, и закрываю.
    Суть проблемы: при первом запуске этой книги спрашивает "разрешить Макросы?", но после разрешения WB_Open не стартует ((. необходимо после этого закрыть и вновь открыть файлик, тогда все ок.
    Прошу совета!

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти