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

时间:2018-07-10 18:33:23

标签: excel vba excel-vba module

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

他们在其他人的支持下回答了他们的问题,

public int Id { get; set; }

但是,它相当大,并且想要展示一种简单的方法来做同样的事情。另外,我发现将模块导入到另一个工作表时,ThisWorkBook和工作表文件也被导入为ClassModules。并非总是如此,因此请参见下面的答案以了解其他选项!

1 个答案:

答案 0 :(得分:4)

您可以使用以下Sub,从其他工作表中导入(或翻转订单,则导出):

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

我创建了一个单独的子来删除我不想保留的子。如果愿意,您可以直接从上一个子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 进行创建,也可以将类型的Call语句构建到上一个子中,但出于本示例的考虑,它完全是一个单独的Sub。

If

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