Страницы: 1
RSS
Копирование модуля в "ЭтаКнига"
 
В файле 3 модуля. Первый - функция, выполняющая вставку модуля № 3 в новый файл, второй - выполняет копирование листа и запускает функцию.
У меня не получается скопированный модуль засунуть в новый файл в "ЭтаКнига", вместо этого он создает модуль в новой книге.
 
Цитата
Sniaper: не получается скопированный модуль засунуть в новый файл в "ЭтаКнига",
модуль листа и книги - не отдельный элемент, а встроенный, поэтому просто скопируйте текст из своего модуля в модуль книги (двойной клик по элементу "эта книга" в редакторе VB) нужного файла
Изменено: Jack Famous - 26.10.2020 17:42:17
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
А что и куда Вы копируете? Где та строка, которая показывает копировать код в модуль ЭтаКнига?
Если же Вы хотите из стандартного модуля скопировать код в ЭтаКнига - изучайте код 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)
Изменено: Дмитрий(The_Prist) Щербаков - 26.10.2020 17:53:00
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Sniaper написал:
вместо этого он создает модуль в новой книге.
макрос делает то, что в нем написано и ни как по другому. и не делает ничего ВМЕСТО ТОГО, что в нем написано
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Дмитрий(The_Prist) Щербаков, Копирую лист в новую книгу и в нее же хочу скопировать модуль3 на место "ЭтаКнига". И да, спасибо за исходники  
 
Цитата
Sniaper написал:
хочу скопировать модуль3 на место "ЭтаКнига".
см. выше - дополнил сообщение чуть измененным кодом.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Спасибо большое за помощь! Все работает
Страницы: 1
Наверх