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

4

有人在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和Sheet文件也被导入为ClassModules。这并不总是理想的,因此请参见下面的答案以获取替代选项!

2个回答

7

您可以使用以下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

我创建了一个独立的子程序来删除我不感兴趣保留的内容。如果您喜欢,可以直接从前一个子程序中调用它,或者将类型的If语句也构建到前一个子程序中,但为了本例子的简洁,它是完全独立的一个子程序。

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

希望这能帮助到大家!

0

我在导入模块时遇到了问题,它们的名称末尾会添加一个1。 我之前试过先删除它们,然后再全部导入,但是删除操作直到子程序结束才执行。


目前你的回答不够清晰,请编辑并添加更多细节,以帮助其他人理解它如何回答问题。你可以在帮助中心找到有关如何编写好答案的更多信息。 - Mario Mateaș

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接