А что и куда Вы копируете? Где та строка, которая показывает копировать код в модуль ЭтаКнига?
Если же Вы хотите из стандартного модуля скопировать код в ЭтаКнига - изучайте код CopyVBComponent(я там вполне подробные комментарии оставил). Там есть блок, отвечающий за копирование строк кодов в модулях листов и книг.
По сути Вам нужен этот блок:
Код |
---|
If objVBComp.Type = 100 Then
.....
End If |
вот, т.к. функция моя - легкая доработка и все работает:
Код |
---|
'---------------------------------------------------------------------------------------
' 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, 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
Dim lSlashPos As Long, lExtPos As Long
'Проверяем корректность указанных параметров
On Error Resume Next
Set objVBProjFrom = wbFromFrom.VBProject
Set objVBProjTo = wbFromTo.VBProject
If objVBProjFrom Is Nothing Then
CopyVBComponent = False: Exit Function
End If
If objVBProjTo Is Nothing Then
CopyVBComponent = False: Exit Function
End If
If Trim(sModuleName) = "" Then
CopyVBComponent = False: Exit Function
End If
If objVBProjFrom.Protection = 1 Then
CopyVBComponent = False: Exit Function
End If
If objVBProjTo.Protection = 1 Then
CopyVBComponent = False: Exit Function
End If
Set objVBComp = objVBProjFrom.VBComponents(sModuleName)
If objVBComp Is Nothing Then
CopyVBComponent = False: Exit Function
End If
'====================================================
'полный путь для экспорта/импорта модуля. К папке должен быть доступ на запись/чтение
sTmpFolderPath = Environ("Temp") & "\" & sModuleName & ".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
.Remove .Item(sModuleToName)
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
'Получаем имя компонента из экспортированного файла
lSlashPos = InStrRev(sTmpFolderPath, "\")
lExtPos = InStrRev(sTmpFolderPath, ".")
sVBCompName = Mid(sTmpFolderPath, lSlashPos + 1, lExtPos - lSlashPos - 1)
'====================================================
'копируем
Set objVBComp = Nothing
' Set objVBComp = objVBProjTo.VBComponents(sVBCompName)
Set objVBComp = objVBProjTo.VBComponents(sModuleToName)
If objVBComp Is Nothing Then
objVBProjTo.VBComponents.Import sTmpFolderPath
Else
'Если компонент - модуль листа или книги -
'его нельзя удалить. Поэтому удаляем из него весь код
'и добавляем код из копируемого компонента
If objVBComp.Type = 100 Then
'создаем временный компонент
Set objTmpVBComp = objVBProjTo.VBComponents.Import(sTmpFolderPath)
'копируем из него код
With objVBComp.CodeModule
.DeleteLines 1, .CountOfLines
sModuleCode = objTmpVBComp.CodeModule.Lines(1, objTmpVBComp.CodeModule.CountOfLines)
.InsertLines 1, sModuleCode
End With
On Error GoTo 0
'удаляем временный компонент
objVBProjTo.VBComponents.Remove objTmpVBComp
End If
End If
'удаляем временный файл компонента
Kill sTmpFolderPath
CopyVBComponent = True
End Function
|
ну а вызывать функция можно так:
Код |
---|
CopyVBComponent("Module3", ThisWorkbook.CodeName, ThisWorkbook, ActiveWorkbook, True) |