Question

我正在尝试创建一个用于创建其他.xlsm工作簿的工作簿，但无法弄清楚如何获取我需要的模块，以便我可以添加它们。

我的代码如下所示（根据此处给出的答案进行了修改：How to add excel 2010 macro programmatically）

我需要帮助的地方在注释'LIST MODULES HERE

的ImportModules子中

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

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

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

希望有所帮助

Answer 2

你可以通过这样的模块。创建一些集合，然后迭代VBProject的VBComponents中的所有对象（模块的类型值为1）：

<android.support.design.widget.FloatingActionButton
    android:id="@+id/close"
    android:layout_width="wrap_content"
    android:layout_height="wrap_content"
    android:layout_gravity="bottom|center_horizontal"
    android:layout_marginBottom="70dp"
    android:layout_marginRight="80dp"
    android:src="@drawable/phone"
    app:backgroundTint="#44FF0000" />

Answer 3

您可以使用简单的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可以检查模块的类型（Form，Normal Module，ClassModule等）

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

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”

VBA - 获取工作簿中的模块

5 个答案: