VBA - 获取工作簿中的模块

Question

我正在尝试创建一个工作簿，用于创建其他.xlsm工作簿，但是不知道如何获取所需的模块以便添加它们。

我的代码如下（修改自此处给出的答案：如何以编程方式添加Excel 2010宏）

我需要帮助的地方在ImportModules子程序中，即'LIST MODULES HERE的注释处。

如何获得当前工作簿中的模块数组？

Private Sub SVAmaker_Click()

    Dim file As String
    file = InputBox("SVA Planner file name", "Name", "Name")

    Application.DefaultSaveFormat = xlOpenXMLWorkbookMacroEnabled
    Workbooks.Add
    ActiveWorkbook.SaveAs filename:=file

    Dim WB As Workbook
    WB = ActiveWorkbook
    Call ImportModules(VBA.CStr(WB))

End Sub

Sub ImportModules(sWorkbookname As String)

    Dim cmpComponents As VBIDE.VBComponents
    Dim wbkTarget As Excel.Workbook

    Set wbkTarget = Workbooks.Open(sWorkbookname)

    If wbkTarget.VBProject.Protection = 1 Then
        Debug.Print wbkTarget.Name & " has a protected project, cannot import module"
    GoTo Cancelline
    End If

    Set cmpComponents = wbkTarget.VBProject.VBComponents

    Dim vModules As Variant
    'LIST MODULES HERE

    Dim i As Integer
    For i = LBound(vModules) To UBound(vModules)
        cmpComponents.Import vModules(i)
    Next i

Cancelline:

    If wbkTarget.FileFormat = xlOpenXMLWorkbook Then
        wbkTarget.SaveAs wbkTarget.Name, xlOpenXMLWorkbookMacroEnabled
        wbkTarget.Close SaveChanges:=False
    Else
        wbkTarget.Close SaveChanges:=True
    End If

    Set wbkTarget = Nothing

End Sub

- JChristen

Answer 1

JChristen要求列出这些模块的清单

我会创建一个基于gizlmo提议的集合：

    Dim vbcomp As VBComponent
    Dim modules as Collection

    set modules = new Collection
    For Each vbcomp In ThisWorkbook.VBProject.VBComponents

        'if normal or class module
        If ((vbcomp.Type = vbext_ct_StdModule) _
             Or _
            (VBComp.Type = vbext_ct_ClassModule)) Then 

           modules.add VBcomp.name

        End If
    Next vbcomp

稍后您可以像这样使用此集合：

    Dim module     as Variant
    for each module in modules
        ' e.g. importing the module 
        import module
    next module

希望这能帮助到您。

- Joe Phi

Answer 2

你可以使用简单的 For Each 循环遍历所有模块。 需要引用 "Microsoft Visual Basic for Applications Extensibility"！

Dim vbcomp As VBComponent

For Each vbcomp In ThisWorkbook.VBProject.VBComponents

    'if normal Module
    If vbcomp.Type = vbext_ct_StdModule Then

        'Do Stuff
    End If
Next vbcomp

使用.Type可以检查模块的类型（表单、普通模块、类模块等）。

- gizlmo

Answer 3

您可以按照以下方式浏览模块。创建一些集合，然后迭代VBProject的VBComponents中的所有对象（模块的类型值为1）：

'declare some collection, which will contain modules
For Each vbc In ThisWorkbook.VBProject.VBComponents
   if vbc.Type = 1 then
       'add to temporary collection ... for example for name, use vbc.name
   end if
Next

- holmicz

---

实际上，看着你的代码，你不需要任何集合，只需遍历cmpComponents并检查其组件类型，如果它等于1，则是模块，你可以导入它。 - holmicz

Answer 4

这段代码应该会有所帮助。它将把所有模块导出到桌面，创建一个新的工作簿并将它们全部导入其中。

Public Sub ExportImportAllModules()

    Dim srcVBA As Variant
    Dim tgtVBA As Variant
    Dim srcModule As Variant
    Dim wrkBk As Workbook
    Dim sDeskTop As String

    On Error GoTo ERROR_HANDLER

    Application.DisplayAlerts = False

    Set srcVBA = ThisWorkbook.VBProject
    sDeskTop = CreateObject("WScript.Shell").specialfolders("Desktop")
    Set wrkBk = Workbooks.Add(xlWBATWorksheet) 'New workbook with 1 sheet.
    Set tgtVBA = wrkBk.VBProject

    For Each srcModule In srcVBA.vbComponents
        'There may be a better way to check it's a module -
        'I'm making it up as I go along.
        If srcModule.Type = 1 Then 'vbext_ct_StdModule
            srcModule.Export sDeskTop & "\" & srcModule.Name
            tgtVBA.vbComponents.Import sDeskTop & "\" & srcModule.Name
            Kill sDeskTop & "\" & srcModule.Name
        End If
    Next srcModule

    Application.DisplayAlerts = True

    On Error GoTo 0
    Exit Sub

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure ExportImportAllModules."
            Err.Clear
            Application.EnableEvents = True
    End Select

End Sub

- Darren Bartrup-Cook

Answer 5

为什么不直接复制你导入模块的“主”工作簿呢？

Option Explicit

Private Sub SVAmaker_Click()

    Dim fso As New FileSystemObject
    Dim myFile As file        
    Dim fileName As String

    fileName = InputBox("SVA Planner file name", "Name", "Name") & ".xlsm"

    Set myFile = fso.GetFile(ActiveWorkbook.FullName)
    fso.CopyFile myFile, myFile.ParentFolder & "\" & fileName

End Sub

从这里开始，您将拥有一个新的工作簿，其中包含所有模块（和工作表）。

如果您需要删除一些工作表，只需打开它并使用“普通”的 VBA Excel 模型对象代码进行操作。

为了使用 FileSytemObject API，您需要引用“Microsoft Scripting Runtime”。

- user3598756

---

这更多是为了让我在最后一周的工作中保持娱乐性的练习。不过还是谢谢你的回答！ - JChristen