Страницы: 1
RSS
Комплексное обновление (изменение содержания) всех модулей n-кол-ва книг в папке через VBA из другой (ОСНОВНОЙ) книги
 
Доброго времени суток! Хорошего дня всем, кто уделяем время на прочтение топика. Прошу прощения, если заголовок сформулирован неясно. Пожалуйста, вникните в следующий текст и, если кому-либо в голову придет более ясно сформулированное название темы - предложите, изменим.

Суть: есть n-ое кол-во книг в папке. Все книги - однообразны по структуре содержания модулей и алгоритм работы модулей у всех один. Бывает, что приходит озарение и появляется мысль о том, как оптимизировать работу какого-либо кода или изменить структуру userform. Каким образом я могу разом заменить модули во всех необходимых книгах путем использования VBA?
В голову лезет только импорт\экспорт модулей. Как это возможно реализовать через VBA ?
Спасибо!
Улыбнись.
 
А зачем для каждой книги свои одинаковые модули?
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, каждая книга это отчет по какой-либо организации. Отчеты однообразны. Каждая книга имеет возможность при помощи VBA добавлять различную информацию и удалять, т.е. принцип работы кодов в каждой книге одинаковый, разное лишь содержание самих книг.
Бывает, что становится известно о каком-либо баге и возникает необходимость, а потом и возможность его исправить. Я исправляю его в книге-шаблоне, тестирую, а потом необходимо новый, обновленный код запихать во все книги вместо старого. Думаю, как избавить руки от этого и делегировать задачу компуктеру...
Улыбнись.
 
Цитата
falmrom написал: В голову лезет только импорт\экспорт модулей. Как это возможно реализовать через VBA ?
Не пускайте это в свою голову!
Это делается так:
Шаблон отчета, вместе с кодом его формирования, хранится в одной книге. Насколько я понял у Вас так и сделано. При необходимости составления отчета по каким либо данным, в этот файл-шаблон подтягиваются данные из нужной книги, формируется отчет, печатается (или сохраняется по своим именем). Файл-шаблон закрывается без сохранения изменений
Схематично как-то так
Согласие есть продукт при полном непротивлении сторон
 
Правильные ли алгоритм работы макроса по замене модулей, форм, событий я представляю?

Скорректируете, пожалуйста, алгоритм действий, если у кого есть соображения на эту тему.
1) Указываем имена необходимых модулей, форм, событий
2)Импортируем указанные модули, формы, события в папку (Code)
3)Узнаем имена всех файлов в папке для дальнейшего поочередного открытия и изменения содержимого
for i = ПерваяКнига to Последняя книга
4)Открываем i файл (книгу)
5)Удаляем все имеющиеся модули, формы, события
6)Экспортируем все из папки (Code)
7)Закрываем обрабатываемую книгу
next
8)msgbox "Готово."
Изменено: falmrom - 18.07.2019 09:45:57
Улыбнись.
 
falmrom, в алгоритме не хватает пункта проверки прав на доступ к модели данных, ну и в целом идея на гране.
Цитата
falmrom написал:
каждая книга это отчет по какой-либо организации.
это означает что надо иметь единое хранилище данных и единый отчет, который с ним работает и может настраиваться на ту или иную организацию.
По вопросам из тем форума, личку не читаю.
 
Я задал вопрос , а Sanja, описал то что я хотел написать после ответа  :D .
Зачем плодить кучу файлов с одинаковыми обработчиками, если можно написать это все один раз и обрабатывать все однотипные книги.
Это как цикл в программировании, можно кучу раз написать один и тот же обработчик события, или запихнуть одну строку в цикл. Вы пытаетесь
кучу раз написать обработчик. Попробуйте подойти с другой стороны, и головная боль по данной теме просто исчезнет.
Изменено: Nordheim - 18.07.2019 09:15:14
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, БМВ, то, что Вы пишите - максимально логично и правильно и я бы очень хотел сделать именно так, но в нашей работе полная автоматизация и полное однообразие - невозможно. В отчетах всегда есть какие-либо пометки в неожиданных местах, которые должны быть именно там, где они есть, а обучить каку-либо базу запоминать пометки и их местоположение - для меня проблематично. Мне не жалко 40 мб ещемесячно на кучу обработчиков. =)
По поводу проверки защищенности - мне ни к чему. Я книги не защищаю, все открыто. =)
Улыбнись.
 
По теме

Осуществить экспорт всех модулей из текущей книги, в указанную папку, в виде соответствующих файлов, можно так : (VBProject не должен быть защищён)

Код
Private Sub ExportAllVBComponents() 
    iTempPath$ = Environ("Temp") & "\" 'укажите свою папку 
    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents 
        Select Case iVBComponent.Type 
            Case 1: iType$ = ".bas" 
            Case 3: iType$ = ".frm" 
            Case 2, 100: iType$ = ".cls" 
        End Select 
        iVBComponent.Export _ 
        FileName:=iTempPath$ & iVBComponent.Name & iType$ 
    Next 
End Sub
Для того, чтобы программно импортировать текстовый файл .bas или .txt, который уже содержит некий программный код (макрос), можно использовать несколько вариантов :

Вариант I.
Код
ThisWorkbook.VBProject.VBComponents.Import "C:\Модуль1.bas"

Примечание : Если в текущей книге уже находится модуль с именем, которое совпадает с именем, которое, как правило, находится в самой первой 
строке текстового файла и выглядит так, Attribute VB_Name = "Модуль1", то импорт пройдёт успешно. 
Только имя нового модуля будет немного отличаться. Например, если мы импортируем модуль с именем "Модуль1", а такой уже есть, 
то появится "Модуль11". Если и такое имя уже занято, то "Модуль12" и т.д. 

Комментарий : Обратите внимание на то, что этот способ позволяет импортировать не только стандартный модуль, но и модуль класса .cls, а также формы .frm 
Вариант II.
Код
ThisWorkbook.VBProject.VBComponents.Add(1).CodeModule.AddFromFile "C:\Модуль1.bas"

Примечание : При таком способе, сначала будет создан стандартный модуль. 
Затем, имя нового модуля будет изменено на указанное в файле, после чего, в новый модуль будет вставлено содержимое указанного файла. 
Если, на момент "импорта", в текущей книге уже находится модуль с таким именем, то возникнет ошибка 32813
Вариант III.
Код
ThisWorkbook.Modules.Add.InsertFile "C:\Модуль1.bas"

Примечание : Этот вариант аналогичен предыдущему, только позволяет создать модуль, даже при отсутствии доверенного доступа к VBProject. 
Но, если есть плюсы, значит есть и минусы. Во первых, так как мы создаём модуль листа, то структура книги не должна быть защищена, 
иначе возникнет ошибка 1004  А во вторых, если текстовый файл, текст которого мы "импортируем", 
содержит информацию о имени модуля, типа Attribute VB_Name = "Модуль1", то такого имени не должно быть не только среди модулей, 
но и среди листов (семейство Sheets)
Согласие есть продукт при полном непротивлении сторон
 
Цитата
falmrom написал:
Я книги не защищаю, все открыто. =)
я о модели данных. по умолчанию Excel не позволяет макросом править макросы. Хотя в случае импорта/экспорта я не проверял.
Цитата
falmrom написал:
а обучить каку-либо базу запоминать пометки и их местоположение - для меня проблематично.
Это делается элементарным профилированием. Есть пользователь - у него роль, у нее специфические настройки +  настройки самого пользователя.
По вопросам из тем форума, личку не читаю.
 
Цитата
falmrom написал:
Мне не жалко 40 мб ещемесячно на кучу обработчиков
Суть не в том, что жалко или не жалко памяти, суть в том что экспортируется во все файлы одно и то же, так какой смысл делать экспорт во все файлы, если можно все обрабатывать одним. Я исхожу из той информации, которую получил в этой теме.
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал: Суть не в том, что жалко или не жалко памяти
Цитата
falmrom написал: В голову лезет только импорт\экспорт модулей.

Nordheim, человеку это фигня уже залезла в голову, он обречен   :cry:  
Согласие есть продукт при полном непротивлении сторон
 
Sanja, верно. Думаю, в процессе оптимизации перейду на оптимальный вариант, который был предложен ранее.
спасибо за коды. После небольших корректировок сделал экспорт таким:
Код
Private Sub ExportAllVBComponents()
            
            On Error Resume Next

    iTempPath = ThisWorkbook.Path & "\Code\" 'папка для кодов
    
        '--------------------------
        CreateObject("Scripting.FileSystemObject").GetFolder(iTempPath).Delete  'удаляем папку
        
        MkDir (iTempPath) 'создаём папку
        '--------------------------

    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
        Select Case iVBComponent.Type
            Case 1: iType$ = ".bas"
            Case 3: iType$ = ".frm"
            Case 2, 100: iType$ = ".cls"
        End Select

        iVBComponent.Export _
        Filename:=iTempPath & iVBComponent.Name & iType$
    Next
End Sub
Остается реализовать удаление всех форм, модулей, событий, что есть в книге и дальнейший импорт.
Улыбнись.
 
Подолью масла в огонь, может Вас быстрее отпустит ;)
Скрытый текст

Еще
Скрытый текст
Согласие есть продукт при полном непротивлении сторон
 
falmrom, ответ не по копированию блоков, а по алгоритму от Sanja:
у меня, кажется, похожая на вашу проблема. Есть файл, в котором можно собирать хоть одну, хоть 100 смет. Такие файлы бывают по объекту (десятки смет) или для коммерческого предложения какого-либо подрядчика (1-5 смет). Разумеется, в процессе работы накапливаются "улучшения" для формы и возникает необходимость "актуализировать" все "вхождения" таких форм-файлов. Сразу скажу, что эти формы не отчёты, а именно программируемые таблицы, густо напичканные макросами с проверками и отчётами.

Выход был придуман такой:
0. Стандартизировать и нормировать все формы для того, чтобы они имели абсолютно одинаковую структуру с учётом всех возможных нюансов. При этом, разумеется, нужно избегать появления "ненужных" столбцов, индивидуальных для какого-либо отчёта. Достигается это на этапе обработки сметы. Т.к. я обрабатываю каждую смету сам, то была выработана форма, в которой всё можно учесть и при этом не плодить "уникальные" поля (слава плоским таблицам и статьям про базы данных).
1. Каждая форма может стать "сборником", то есть в любую из них можно собрать данные из других таких форм для последующего создания сводника
2. Каждая форма может разделиться на количество файлов, равное количеству смет в форме-сборнике (отвергнуто, т.к. было найдено лучшее решение)
2. Каждая форма может стать образцом, то есть мы, находясь в эталонной (на текущий момент) форме, можем пакетно актуализировать файлы-формы по "образцу". При этом "образец" сохраняется, потом очищается, затем наполняется данными из "старой" формы, которая после удаляется, а "обновление" пересохраняется под именем "старой" формы. Таким образом весь набор имён, макросов и прочего полностью соответствует образцу.

Нюансы для гибкости:
1. большое количество именованных диапазонов
2. в кодах вместо статичных чисел типа номеров столбцов, количество столбцов и т.д. используются вычисляемые переменные

Итог: довольно универсальная форма, с возможностью быстрого апдейта любых её копий
Изменено: Jack Famous - 18.07.2019 10:22:48
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Sanja, остался вопрос только в правильном экспорте всех модулей, форм и прочего из папки в книгу. Каким образом возможно это реализовать?

Код на данном этапе:
Код
Private Sub ExportAllVBComponents()
            
            On Error Resume Next
            ОсновнаяКнига = ActiveWorkbook.Name
'Экспорт макросов

    iTempPath = ThisWorkbook.Path & "\Code\" 'папка для кодов
    
        '--------------------------
        CreateObject("Scripting.FileSystemObject").GetFolder(iTempPath).Delete  'удаляем папку
        
        MkDir (iTempPath) 'создаём папку
        '--------------------------

    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
        Select Case iVBComponent.Type
            Case 1: iType$ = ".bas"
            Case 3: iType$ = ".frm"
            Case 2, 100: iType$ = ".cls"
        End Select

        iVBComponent.Export _
        Filename:=iTempPath & iVBComponent.Name & iType$
        
        If iVBComponent.Name = "AAA888обновлениеМаксросов" Then Kill iTempPath & iVBComponent.Name & iType$
    Next
    
    
    
    
    
    'Прерываем действие макроса, если имякниги = имяОсновнойкниги
    If ActiveWorkbook.Name = ОсновнаяКнига Then MsgBox "Что-то пошло не так. Имя активной книги =   [ " & ОсновнаяКнига & " ]   . Так быть не должно. Обратитесь к programist.": Exit Sub
    Application.ScreenUpdating = False





    'Запрос на указание папки с отчетами
    Dim oFD As FileDialog
    Dim ПапкаСОтчетами, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с отчетами" '"заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .InitialFileName = ThisWorkbook.Path '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        ПапкаСОтчетами = .SelectedItems(1) 'считываем путь к папке
    End With
    
     
    'УзнаемСколькоФайлов в Папке
    Set fso = CreateObject("Scripting.FileSystemObject")
    КоличествоФайловВПапкеБезУчётаПодпапок = fso.GetFolder(ПапкаСОтчетами).Files.Count

    
    
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'Перебираем файлы в папке
Dim FILE, MASSIV As Object

Set MASSIV = CreateObject("Scripting.FileSystemObject").GetFolder(ПапкаСОтчетами).Files

ИзмененоФайлов = 0

    For Each FILE In MASSIV
        If Right(FILE, 5) = ".xlsm" Then ' если файл имеет расширение .xlsm, то работаем
                    
                    '-------------------------------------------------------------------------
                    'Открываем файл
                    ChDir ПапкаСОтчетами
                    Workbooks.Open Filename:=FILE


                            '-------------------------------------------------------------------------
                            'Удаление старых макросов в файлах -отчетах
                        
                            For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
                                On Error Resume Next
                                With oVBComponent
                                    Select Case .Type
                                    Case 1    'Модули
                                        .Collection.Remove oVBComponent
                                    Case 2    'Модули Класса
                                        .Collection.Remove oVBComponent
                                    Case 3    'Формы
                                        .Collection.Remove oVBComponent
                                    Case 100    'ЭтаКнига, Листы
                                            lCountLines = .CodeModule.CountOfLines
                                            .CodeModule.DeleteLines 1, lCountLines
                                    End Select
                                End With
                            Next
                            Set oVBComponent = Nothing
                            '-------------------------------------------------------------------------
                            
                            
                            
                                '-------------------------------------------------------------------------
                                'Экспорт макросов
                                Set xSWS = Workbooks(xStrSWSName & ".xlsm")
                                Set xDWS = Workbooks(xSreDWSName & ".xlsm")
                                Set xvbap = xSWS.VBProject
                                Set xVBC = xvbap.VBComponents
                                
                                
                                For Each Module In xSWS.VBProject.VBComponents
                                If Module.Type = vbext_ct_StdModule Then
                                Module.Export (xFilePath & "\" & Module.Name & ".bas")
                                
                                
                                
                                
                                Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Item("Имя модуля").Export "Путь и ИмяФайла"
                                '-------------------------------------------------------------------------
                    
                    
                    
                    '-------------------------------------------------------------------------
                    'Сохраняем, закрываем обрабатываемую книгу
                    ActiveWorkbook.Save
                    ActiveWorkbook.Close
                    
                    

        ИзмененоФайлов = ИзмененоФайлов + 1
        End If
    Next
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------






Application.ScreenUpdating = True


If ИзмененоФайлов Then MsgBox "Не обновлен ни один файл. Возможно выбрана неверная папка." & Chr(10) & "Изменения происходят только с файлами, которые имеют расширение «.xlsm»", vbOKOnly + vbCritical, "": Exit Sub
MsgBox "ГОТОВО!" & Chr(10) & "Изменено файлов: " & ИзмененоФайлов & " из " & КоличествоФайловВПапкеБезУчётаПодпапок, vbOKOnly + vbInformation, "ГОТОВО!"
End Sub


Изменено: falmrom - 18.07.2019 13:29:52
Улыбнись.
 
Делюсь итоговым кодом:
Код
Private Sub ExportAllVBComponents()
            
            On Error Resume Next
            ОсновнаяКнига = ActiveWorkbook.Name
'Экспорт макросов

    iTempPath = ThisWorkbook.Path & "\Code\" 'папка для кодов
    
        '--------------------------
        CreateObject("Scripting.FileSystemObject").GetFolder(iTempPath).Delete  'удаляем папку
        
        MkDir (iTempPath) 'создаём папку
        '--------------------------


    ВсегоКомпонентов = ThisWorkbook.VBProject.VBComponents.Count
    ReDim Содержание(1 To ВсегоКомпонентов) ' от [одного] до [Кол-во компонентов]
    
    НомерСодержания = 0
    
    
    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
        Select Case iVBComponent.Type
            Case 1: iType$ = ".bas"
            Case 3: iType$ = ".frm"
            Case 2, 100: iType$ = ".cls"
        End Select


        НомерСодержания = НомерСодержания + 1
        Содержание(НомерСодержания) = iTempPath & iVBComponent.Name & iType$
        
        iVBComponent.Export _
        Filename:=Содержание(НомерСодержания)
        
        
        If iVBComponent.Name = "AAA888обновлениеМаксросов" Then Kill iTempPath & iVBComponent.Name & iType$
    Next
    
    



    'Запрос на указание папки с отчетами
    Dim oFD As FileDialog
    Dim ПапкаСОтчетами, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с отчетами" '"заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .InitialFileName = ThisWorkbook.Path '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        ПапкаСОтчетами = .SelectedItems(1) 'считываем путь к папке
    End With
    
     
    'УзнаемСколькоФайлов в Папке
    Set fso = CreateObject("Scripting.FileSystemObject")
    КоличествоФайловВПапкеБезУчётаПодпапок = fso.GetFolder(ПапкаСОтчетами).Files.Count

    
    
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'Перебираем файлы в папке
Dim FILE, MASSIV As Object

Set MASSIV = CreateObject("Scripting.FileSystemObject").GetFolder(ПапкаСОтчетами).Files

ИзмененоФайлов = 0

    For Each FILE In MASSIV
        If Right(FILE, 5) = ".xlsm" Then ' если файл имеет расширение .xlsm, то работаем
                    
                    '-------------------------------------------------------------------------
                    'Открываем файл
                    ChDir ПапкаСОтчетами
                    Workbooks.Open Filename:=FILE
                    
                            'Прерываем действие макроса, если имякниги = имяОсновнойкниги
                            If ActiveWorkbook.Name = ОсновнаяКнига Then MsgBox "Что-то пошло не так. Имя активной книги =   [ " & ОсновнаяКнига & " ]   . Так быть не должно. Обратитесь к programist.": Exit Sub
                            Application.ScreenUpdating = False


                            '-------------------------------------------------------------------------
                            'Удаление старых макросов в файлах -отчетах
                        
                            For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
                                On Error Resume Next
                                With oVBComponent
                                    Select Case .Type
                                    Case 1    'Модули
                                        .Collection.Remove oVBComponent
                                    Case 2    'Модули Класса
                                        .Collection.Remove oVBComponent
                                    Case 3    'Формы
                                        .Collection.Remove oVBComponent
                                    Case 100    'ЭтаКнига, Листы
                                            lCountLines = .CodeModule.CountOfLines
                                            .CodeModule.DeleteLines 1, lCountLines
                                    End Select
                                End With
                            Next
                            Set oVBComponent = Nothing
                            '-------------------------------------------------------------------------
                            
                            
                            
                                '-------------------------------------------------------------------------
                                'Импорт макросов
                                 For i = 1 To ВсегоКомпонентов
                                    
                                    Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Import Содержание(i)
                                 
                                 Next i
                                '-------------------------------------------------------------------------
                    
                    
                    
                    '-------------------------------------------------------------------------
                    'Сохраняем, закрываем обрабатываемую книгу
                    ActiveWorkbook.Save
                    ActiveWorkbook.Close
                    
                    

        ИзмененоФайлов = ИзмененоФайлов + 1
        End If
    Next
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------






Application.ScreenUpdating = True


If ИзмененоФайлов Then MsgBox "Не обновлен ни один файл. Возможно выбрана неверная папка." & Chr(10) & "Изменения происходят только с файлами, которые имеют расширение «.xlsm»", vbOKOnly + vbCritical, "": Exit Sub

MsgBox "ГОТОВО!" & Chr(10) & "Изменено файлов: " & ИзмененоФайлов & " из " & КоличествоФайловВПапкеБезУчётаПодпапок, vbOKOnly + vbInformation, "ГОТОВО!"

End Sub


Улыбнись.
 
falmrom,  зачем оставлять в коде столбко пустот?
 
Советую еще почитать классику.
Владимир
 
Off
Цитата
vikttur написал:
зачем оставлять в коде столбко пустот?
Это для тренировки указательного пальца при скроллинге.
По вопросам из тем форума, личку не читаю.
 
vikttur, для быстрой ориентации в содержимом.
sokol92, спасибо за совет!
БМВ, верно.

Возникла проблема! Компонент «ЭтотЛист» невозможно удалить. Как в таком случае ЗАМЕНИТЬ в нем содержимое на то, что есть в файле?
Улыбнись.
 
Цитата
falmrom написал:
Возникла проблема!
закономерно.
чем дольше Вы будете пытаться модифицировать код с помощью кода, тем больше проблем Вас ожидают на этом пути
может просто для начала нужно научить писать универсальный и корректный код и если окажется, что навык усвоен, то, возможно,  отпадет необходимость осваивать технику исправления кода кодом...
Изменено: Ігор Гончаренко - 18.07.2019 14:48:46
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Проблема решена. Код:
Код
Private Sub ExportAllVBComponents()
            
            On Error Resume Next
            ОсновнаяКнига = ActiveWorkbook.Name
'Экспорт макросов

    iTempPath = ThisWorkbook.Path & "\Code\" 'папка для кодов
    
        '--------------------------
        CreateObject("Scripting.FileSystemObject").GetFolder(iTempPath).Delete  'удаляем папку
        
        MkDir (iTempPath) 'создаём папку
        '--------------------------


    ВсегоКомпонентов = ThisWorkbook.VBProject.VBComponents.Count
    ReDim Содержание(1 To ВсегоКомпонентов) ' от [одного] до [Кол-во компонентов]
    
    НомерСодержания = 0
    
    
    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
        Select Case iVBComponent.Type
            Case 1: iType$ = ".bas"
            Case 3: iType$ = ".frm"
            Case 2, 100: iType$ = ".cls"
        End Select


        НомерСодержания = НомерСодержания + 1
        Содержание(НомерСодержания) = iTempPath & iVBComponent.Name & iType$
        
        iVBComponent.Export _
        Filename:=Содержание(НомерСодержания)
        
        
            If iVBComponent.Name = "AAA888обновлениеМаксросов" Then Kill iTempPath & iVBComponent.Name & iType$ 'Удаляем этот модуль, чтобы не импортировать его в книги-отчеты
        
        
            'Запоминаем содержимое модулей, а их удаляем из папки, чтобы не импортировать в файлы-отчеты
            КолВоСтрокВКомпоненте = ThisWorkbook.VBProject.VBComponents.Item(iVBComponent.Name).CodeModule.CountOfLines
            
            If iVBComponent.Name = "ЭтаКнига" Then
            СодержЭтаКнига = ThisWorkbook.VBProject.VBComponents.Item(iVBComponent.Name).CodeModule.Lines(1, КолВоСтрокВКомпоненте)
            Kill iTempPath & iVBComponent.Name & iType$
            End If
            
            If iVBComponent.Name = "Лист1" Then
            СодержЛист1 = ThisWorkbook.VBProject.VBComponents.Item(iVBComponent.Name).CodeModule.Lines(1, КолВоСтрокВКомпоненте)
            Kill iTempPath & iVBComponent.Name & iType$
            End If
            
            If iVBComponent.Name = "Лист2" Then
            СодержЛист2 = ThisWorkbook.VBProject.VBComponents.Item(iVBComponent.Name).CodeModule.Lines(1, КолВоСтрокВКомпоненте)
            Kill iTempPath & iVBComponent.Name & iType$
            End If
            
            If iVBComponent.Name = "Лист3" Then
            СодержЛист3 = ThisWorkbook.VBProject.VBComponents.Item(iVBComponent.Name).CodeModule.Lines(1, КолВоСтрокВКомпоненте)
            Kill iTempPath & iVBComponent.Name & iType$
            End If

    Next
    
    



    'Запрос на указание папки с отчетами
    Dim oFD As FileDialog
    Dim ПапкаСОтчетами, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с отчетами" '"заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .InitialFileName = ThisWorkbook.Path '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        ПапкаСОтчетами = .SelectedItems(1) 'считываем путь к папке
    End With
    
     
    'УзнаемСколькоФайлов в Папке
    Set fso = CreateObject("Scripting.FileSystemObject")
    КоличествоФайловВПапкеБезУчётаПодпапок = fso.GetFolder(ПапкаСОтчетами).Files.Count

    
    
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'Перебираем файлы в папке
Dim FILE, MASSIV As Object

Set MASSIV = CreateObject("Scripting.FileSystemObject").GetFolder(ПапкаСОтчетами).Files

ИзмененоФайлов = 0

    For Each FILE In MASSIV
        If Right(FILE, 5) = ".xlsm" Then ' если файл имеет расширение .xlsm, то работаем
                    
                    '-------------------------------------------------------------------------
                    'Открываем файл
                    ChDir ПапкаСОтчетами
                    Workbooks.Open Filename:=FILE
                    
                            'Прерываем действие макроса, если имякниги = имяОсновнойкниги
                            If ActiveWorkbook.Name = ОсновнаяКнига Then MsgBox "Что-то пошло не так. Имя активной книги =   [ " & ОсновнаяКнига & " ]   . Так быть не должно. Обратитесь к programist.": Exit Sub
                            Application.ScreenUpdating = False
                            

                            '-------------------------------------------------------------------------
                            'Удаление старых макросов в файлах -отчетах
                        
                            For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
                                On Error Resume Next
                                With oVBComponent
                                    Select Case .Type
                                    Case 1    'Модули
                                        .Collection.Remove oVBComponent
                                    Case 2    'Модули Класса
                                        .Collection.Remove oVBComponent
                                    Case 3    'Формы
                                        .Collection.Remove oVBComponent
                                    Case 100    'ЭтаКнига, Листы
                                            lCountLines = .CodeModule.CountOfLines
                                            .CodeModule.DeleteLines 1, lCountLines
                                    End Select
                                End With
                            Next
                            Set oVBComponent = Nothing
                            '-------------------------------------------------------------------------
                            
                            
                            
                                '-------------------------------------------------------------------------
                                'Импорт макросов
                                 For i = 1 To ВсегоКомпонентов
                                    
                                    Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Import Содержание(i)
                                 
                                 Next i
                                 
                                 
                                 'Вставка новых строк в модуль проекта
                                  Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Item("ЭтаКнига").CodeModule.InsertLines 1, СодержЭтаКнига
                                  Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Item("Лист1").CodeModule.InsertLines 1, СодержЛист1
                                  Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Item("Лист2").CodeModule.InsertLines 1, СодержЛист2
                                  Workbooks(ActiveWorkbook.Name).VBProject.VBComponents.Item("Лист3").CodeModule.InsertLines 1, СодержЛист3
   
                                '-------------------------------------------------------------------------
                    
                    
                    
                    '-------------------------------------------------------------------------
                    'Сохраняем, закрываем обрабатываемую книгу
                    ActiveWorkbook.Save
                    ActiveWorkbook.Close
                    
                    

        ИзмененоФайлов = ИзмененоФайлов + 1
        End If
    Next
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------






Application.ScreenUpdating = True


If ИзмененоФайлов = 0 Then MsgBox "Не обновлен ни один файл. Возможно выбрана неверная папка." & Chr(10) & "Изменения происходят только с файлами, которые имеют расширение «.xlsm»", vbOKOnly + vbCritical, "": Exit Sub

MsgBox "ГОТОВО!" & Chr(10) & "Изменено файлов: " & ИзмененоФайлов & " из " & КоличествоФайловВПапкеБезУчётаПодпапок, vbOKOnly + vbInformation, "ГОТОВО!"

End Sub


Улыбнись.
 
Ігор Гончаренко, дело пишите, но уже начал реализацию именно через этот нелогичный, жесткий путь. В принципе - код готов. Пробуйте его. Он выше.
Улыбнись.
 
Цитата
falmrom написал: Пробуйте его
8-0 Чур меня! Вдруг заразно?!
Цитата
falmrom написал: но уже начал реализацию именно через этот нелогичный, жесткий путь
Вам же в самом начале указали ПРАВИЛЬНЫЙ путь!
Согласие есть продукт при полном непротивлении сторон
 
Sanja, с удовольствием бы! Но пока не имею знаний, чтобы заниматься подобной реализации. Все в процессе и со временем. В будущем переведу все именно на ту форму, что описывалась ранее, на ту, которая оптимальная, логичная, простая, обкатанная и стандартная для всех. Я учусь этому ежедневно.
Улыбнись.
 
Цитата
falmrom написал: В будущем переведу...
Ооооочень сомневаюсь. Вы изначально завязнете в своих неправильных путях.
Какая разница, раз Вы начинали с нуля, что начинать реализовывать?
Согласие есть продукт при полном непротивлении сторон
Страницы: 1
Наверх