Как добавить код процедуры программно, скопировать модуль
Бывают ситуации, когда кодом создается книга, в нее опять же кодом заносятся данные. И порой необходимо помимо всего прочего добавить в новую книгу и код VBA. Естественно, тоже программно. На самом деле это совсем не сложно.
Для изменения кодов программно необходимо, чтобы было проставлено доверие к объектной модели проекта VBA и изменяемый проект не должен быть защищен. Подробнее читайте в статье: Что необходимо для внесения изменений в проект VBA(макросы) программно
Без этого будет невозможно программное вмешательство в проект VBA.
В данной статье я покажу как программно выполнить следующее:
- Как копировать модуль из одной книги в другую;
- Как создать новый модуль;
- Как создать событийную процедуру (изменение данных на листе, открытие книги и т.п.).
Так же приведена функция, которая копирует указанный модуль из одной книги в другую.
Как копировать, экспортировать и импортировать модули вручную описано в этой статье
Теперь перейдем непосредственно к сути. Сначала рассмотрим добавление в проект стандартного модуля.
Для добавления стандартного модуля и кода в нем можно воспользоваться двумя методами:
- Экспорт имеющегося модуля(с процедурами) из книги с кодом в новую книгу. Чаще всего применяется когда кодов для записи в новую книгу довольно много и создавать их все, прописывая в коде, весьма неудобно и громоздко;
- Создание нового модуля и запись необходимых кодов в него. Применяется, если необходимо создать относительно короткие процедуры в модуле.
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 из одной книги в другую.
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 ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
прекрасная прога! спасибо большое! но! у меня возникла небольшая проблема пишет
objVBProjFrom=nothing и выкидывает меня из процедуры (согласно вообщем то логике процедуры). не могу понять почему у меня objVBProjFrom=nothing равно как и objVBProjTo=nothing. Все вроде делаю как надо- задают workbook to & from... почему это может быть не подскажете?
В самом начале статьи есть примечание со ссылкой на статью: Что необходимо для внесения изменений в проект VBA(макросы) программно
Спасибо огромное!!!! Все получилось! супер сайт и проги!
Спасибо, Дмитрий
Вопрос: при запуске макроса для "создания новых модулей и процедур" с загруженной UserForm (но, не уверен, что в этом причина) весь процесс "создания" появляется на экране (т.е. открывается VBA и визуально видно как все эти новые модули, формы, процедуры создаются). Как визуально скрыть процесс?
Application.DisplayAlerts = False или Application.ScreenUpdating = False не помогает.
Добрый день.
Пытаюсь пользовать ваш функционал. Столкнулся с проблемой.
Что делаю:
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
Был бы признателен если бы вы подсказали как исключить этот конфликт.
Не вижу кода, который хоть как-то согласуется со статьей. Нет ни одного намека, что какой-то из приведенных кодов добавляется программно.
Очень полезная статься. У меня только вот такой нюансик. Я вставляю в лист событийную процедуру
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 на модуле листа куда я добавил обработчик события. Как сделать чтобы редактор не открывался или может закрыть его программно?
Application.VBE.MainWindow.Visible = False
Доброй ночи. А куда надо вставить этот кусок кода Application.VBE.MainWindow.Visible = False, чтобы окно vbe не открывалось при вставке в модуль листа событийной процедуры?.. пробовал в thisbook - не работает. помогите разобраться пожалста
Долго ковырялся в Нете по теме как победить всплывающее окно VBE при вставке кода в новый лист по событию Change. В итоге нашел, отладил, все работает )http://www.cpearson.com/Excel/vbe.aspx#ScreenFlicker
Ссылка на первоисточник:
Успехов! )
P.S. у меня Win64 )
Спасибо за статью!
Столкнулся с такой проблемой:
Первоначальный код книги был подписан цифровой подписью. Есть ли возможность программного подписания модуля при внесении изменений?
ДД.
Создаю новую книгу, вставляю в нее событийную процедуру Workbook_Open, сохраняю эту книгу, и закрываю.
Суть проблемы: при первом запуске этой книги спрашивает "разрешить Макросы?", но после разрешения WB_Open не стартует ((. необходимо после этого закрыть и вновь открыть файлик, тогда все ок.
Прошу совета!