VBA自动替换多个工作簿中的模块

Question

有人在 mrexcel 上发布了一个问题，询问如何用新的模块替换现有工作簿中的模块: https://www.mrexcel.com/forum/excel-questions/760732-vba-automatically-replace-modules-several-workbooks.html

他们在其他人的支持下回答了他们的问题，如下:

Sub Update_Workbooks()
'This macro requires that a reference to Microsoft Scripting Routine
'be selected under Tools\References in order for it to work.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fso As New FileSystemObject
Dim source As Scripting.Folder
Dim wbFile As Scripting.File
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim Filename As String
Dim ModuleFile As String
Dim Element As Object
Set source = fso.GetFolder("C:\Users\Desktop\Testing")   'we will know this since all of the files will be in one folder
For Each wbFile In source.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then  'we will konw this too. All files will be .xlsm
Set book = Workbooks.Open(wbFile.path)
    Filename = FileNameOnly(wbFile.Name)
    'This will remove all modules including ClassModules and UserForms.
    'It will keep all object modules like (sheets, ThisWorkbook)
    On Error Resume Next
    For Each Element In ActiveWorkbook.VBProject.VBComponents
        ActiveWorkbook.VBProject.VBComponents.Remove Element
        Next

    On Error GoTo ErrHandle
'   Export Module1 from updating workbook
    ModuleFile = Application.DefaultFilePath & "\tempmodxxx.bas"
    Workbooks("Update Multiple Workbooks.xlsm").VBProject.VBComponents("Module1") _
    .Export ModuleFile
'   Replace Module1 in Userbook
    Set VBP = Workbooks(Filename).VBProject
    On Error Resume Next
    With VBP.VBComponents
        .Import ModuleFile
    End With
'   Delete the temporary module file
    Kill ModuleFile

book.Close True
End If
Next
    Exit Sub
ErrHandle:
'   Did an error occur?
    MsgBox "ERROR. The module may not have been replaced.", _
      vbCritical
End Sub

但是，它相当大，并且想要展示一种做同样事情的简单方法。另外，我发现当将模块导入到不同的工作表时，ThisWorkBook 和工作表文件也会作为 ClassModules 导入。这并不总是理想的，因此请参阅下面的答案以获取替代选项!

Answer 1

您可以使用以下子命令从不同的工作表导入(或导出，如果翻转顺序)模块:

Sub import_mods()
'First define each module you're looking to 
'take from the excel sheet "Workbook_with_Modules.xlsm"

For Each Element In Workbooks("Workbook_with_Modules.xlsm").VBProject.VBComponents

    'MsgBox Element.Name 'I ran this first to see which modules are available

'First, export each module from the "Workbook_with_Modules.xlsm"
Workbooks("Workbook_with_Modules.xlsm").VBProject.VBComponents(Element.Name).Export (Element.Name)

'Then, Import them into the current Workbook
 Workbooks(ThisWorkbook.Name).VBProject.VBComponents.Import (Element.Name)
Next Element

End Sub

我创建了一个单独的子项来删除我不感兴趣保留的子项。如果您愿意，您可以直接从前一个子中调用它，或者也将类型的If语句构建到前一个子中，但就本例而言，它是一个完全独立的 Sub。

Sub rems()
'Types:
'   100 = Sheets and ThisWorkbook for current Workbook
'   1 = Modules (such as "Module1")
'   2 = ClassModules (such as other sheets from a different Workbook "ThisWorkBook1")

For Each Element In Workbooks(ThisWorkbook.Name).VBProject.VBComponents
'I first tested the types and corresponding number
'MsgBox Workbooks(ThisWorkbook.Name).VBProject.VBComponents(Element.Name).Type

'Now, the If function for removing all ClassModules (Type = 2)
        If Workbooks(ThisWorkbook.Name).VBProject.VBComponents(Element.Name).Type = 2 Then
            Workbooks(ThisWorkbook.Name).VBProject.VBComponents.Remove Element
        End If        
Next Element

End Sub

希望这对任何人都有帮助!