Страницы: 1
RSS
Массовое обновление макросов в n-колличестве книг из Основной
 
Доброго времени суток, уважаемые! Всех, с прошедшими праздниками,  повсеместного добра вам и вашим близким, здоровья ранее указанным :)

По существу: будьте добры, подскажите, пожалуйста, код либо альтернативный способ реализации массового обновления макросов в книгах.

Дано: Есть (1) Основная книга, которая содержит в себе последние версии макросов и (2) Папка с 1000 книг, которые содержат в себе полностью идентичные коды в Модулях и в Листах и Формах.

Каким образом возможно реализовать массовое обновление Модулей, Листов, Форм в 1000 книг, взяв за образец то, что в Основной книге?

Заранее благодарю!
Улыбнись.
 
Как-то так
Код
Dim fso As Object

Sub Main()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim dicFiles As Object
    Set dicFiles = CreateObject("Scripting.Dictionary")
    GetFromSubFolders ThisWorkbook.Path, True, dicFiles, "xls"
        
    Dim dicWBModules As Object
    Set dicWBModules = GetModulesList(ThisWorkbook)
        
    Dim v As Variant
    For Each v In dicFiles.Keys
        Job_wb v, dicWBModules
        DoEvents
    Next
        
End Sub
Код
Sub Job_wb(ByVal sFull As String, dicSourceModules As Object)
    Dim wb As Workbook
    Set wb = Workbooks.Open(sFull)
        
    Dim dicWBModules As Object
    Set dicWBModules = GetModulesList(wb)
    
    Dim vModule As Variant
    For Each vModule In dicSourceModules.Keys
        If dicWBModules.Exists(vModule) Then
            Job_module wb, vModule
        End If
    Next
    
    wb.Close True
End Sub
Код
Sub Job_module(wb As Workbook, ByVal sModule As String)
    Dim s As String
    With ThisWorkbook.VBProject.VBComponents(sModule).CodeModule
        s = .Lines(1, .CountOfLines)
    End With
    
    With wb.VBProject.VBComponents(sModule).CodeModule
        .DeleteLines 1, .CountOfLines
        .InsertLines 1, s
    End With
End Sub
Код
Private Function GetModulesList(wb As Workbook) As Object
' Возвращает словарь имен модулей указанной книги.
' Только код-модули, модули классов и пользовательских форм.
' Не возвращает имена модулей листов и ЭтаКнига.
    
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    
    Dim VBProj As Object 'VBIDE.VBProject
    Dim VBComp As Object 'VBIDE.VBComponent
    
    On Error Resume Next
        Set VBProj = wb.VBProject
    On Error GoTo 0
    If VBProj Is Nothing Then
        Set GetModulesList = dic
'        VBOM_Access
        Exit Function
    End If
    
    For Each VBComp In VBProj.VBComponents
    Select Case VBComp.Type
    '    vbext_ct_StdModule Code Module
    '    vbext_ct_ClassModule Class Module
    '    vbext_ct_MSForm UserForm
    '    vbext_ct_Document Document Module, Рабочие листы и Эта книга
    '    vbext_ct_ActiveXDesigner ActiveX Designer
    'Case vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_MSForm
    Case 1, 2, 3
        dic.Add VBComp.Name, ""
    End Select
    Next VBComp
    Set GetModulesList = dic
End Function
Код
Public Sub GetFromSubFolders(sPath As String, ByVal bSubFolders As Boolean, ByRef dicPath As Object, ByVal sTargetType As String, Optional nFiles As Long = 0)
    Dim objFolder As Object
    Dim objFile As Object
    
    If Not fso.FolderExists(sPath) Then Exit Sub
    Set objFolder = fso.GetFolder(sPath)
    
    On Error Resume Next
    
        Select Case sTargetType
        Case ""
            For Each objFolder In objFolder.SubFolders
                dicPath.Add objFolder.Path & "\", ""
                DoEvents
            Next
            Set objFolder = fso.GetFolder(sPath)
        Case Else
            For Each objFile In objFolder.Files
                If nFiles > 0 Then
                    If dicPath.Count >= nFiles Then
                        Exit Sub
                    End If
                End If
                With objFile
                    If fso.GetExtensionName(.Name) Like (sTargetType & "*") Then
                        If Left(.Name, 2) <> "~$" Then
                            If .Name <> ThisWorkbook.Name Then
                                dicPath.Add .Path, .Name
                            End If
                        End If
                    End If
                End With
                DoEvents
            Next
        End Select
        
        If bSubFolders Then
            For Each objFolder In objFolder.SubFolders
                GetFromSubFolders objFolder.Path & "\", True, dicPath, sTargetType, nFiles:=nFiles
                DoEvents
            Next
        End If
    
    On Error GoTo 0
End Sub
 
МатросНаЗебре, Благодарю Вас. Буду вникать в код.
Улыбнись.
 
Если макросами пользуетесь только вы, то лучше вникнуть в то, как написать универсальный код для обработки файлов и держать все в одной надстройке, а не плодить книги с макросами. Лично мое мнение.
"Все гениальное просто, а все простое гениально!!!"
 
МатросНаЗебре, В коде есть пометка «' Не возвращает имена модулей листов и ЭтаКнига.»
Будь добры, подскажите, как сделать так, чтобы кода модулей листов и ЭтаКнига тоже учитывались.
Спасибо!
Улыбнись.
 
А не проще создать пустую книгу с макросами, как шаблон, перетащить туда данные из имеющихся книг и сохранить как
Изменено: msi2102 - 10.01.2020 14:37:13
 
Допишите 100 в код. Должно быть так:
Код
Case 1, 2, 3, 100
 
МатросНаЗебре,
пожалуйста, если не затруднит, расшифруйте, что несут под собой эти цифры и какие еще значение могут быть указаны? Спасибо большое!
Улыбнись.
 
Не затруднит. Это почти все значения.
1___Standard module
2___Class module
3___Microsoft Form
11__ActiveX Designer
100_Document Module
 
МатросНаЗебре, извиняюсь, а как сначала удалить ВСЕ стандарт модули, модули класс, формы, модули листов и книг в обрабатываемой книге, а ПОТОМ производить импорт модулей?
Вижу процесс таким:
1) Запуск кода замены макросов в Книге (1)
2) Выбор папки с книгами, в которых необходимо менять макрососодержимое
3) Цикл перебора книг из папки, в котором:
3.1) Удаляем все модули, формы, чистим модули листОВ и книги
3.2) Импортируем ПРОПИСАННЫЕ РУКАМИ В КОДЕ модули и формы
3.3) Переходим к обработки следующей книги
Улыбнись.
 
А самое главное в этом процессе узнать все ли файлы из 100  обработаны верно, или что то пошло не так и в дальнейшем можно получить в итоге непредвиденный сюрприз  ;)
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх