Question

我浏览了以下网址中有趣的代码示例 https://www.rondebruin.nl/win/s9/win002.htm

http://www.cpearson.com/excel/vbe.aspx

我已经修改了用于导出/导入模块的代码，以满足我的需要，但我仍然无法弄清楚如何导入工作表源代码文件以将其作为工作表代码添加到新工作簿中。保存组件以创建工作表源代码文件时，我可以轻松检查 VBcomponent 类型，但是 import VBcomponent 方法在读取创建的类模块后会错误地创建新的类模块文件，无论我使用什么文件扩展名。 ThisWorkbook 源代码文件也会发生相同的问题。组件类型和文件扩展名是从这段代码中获得的

Public Function VBE_GetFileExtension(VBComp As VBIDE.VBComponent) As String
Select Case VBComp.Type
    Case vbext_ct_ClassModule
        VBE_GetFileExtension = ".cls"
    Case vbext_ct_Document
        VBE_GetFileExtension = ".xcls"
    Case vbext_ct_MSForm
        VBE_GetFileExtension = ".frm"
    Case vbext_ct_StdModule
        VBE_GetFileExtension = ".bas"
    Case Else
        VBE_GetFileExtension = ".bas"
End Select
End Function

我知道可以使用VBA编辑工作表和工作簿源代码，但恐怕效率不高。

这里是完整的导出代码

Public Sub VBE_ExportCodeSource()
    If (Not IsEditorInSync()) Then Call SyncVBAEditor

    On Error GoTo ErrorHandler

    Dim sFolderName As String
    sFolderName = ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".SrcCodeExport"

    'create folder where to save source code files
    Dim bOk As Boolean
    bOk = Z_bIOCreateFolder(sFolderName)

    'create sub folder where to save modules based on the type
    Dim bOk As Boolean
    bOk = Z_bIOCreateFolder(sFolderName)

    Dim sSubFolderName As String
    sSubFolderName = sFolderName & "\" & "Microsoft Excel Objects"
    bOk = Z_bIOCreateFolder(sSubFolderName)
    If (Not bOk) Then GoTo ErrorHandler

    sSubFolderName = sFolderName & "\" & "Forms"
    bOk = Z_bIOCreateFolder(sSubFolderName)
    If (Not bOk) Then GoTo ErrorHandler

    sSubFolderName = sFolderName & "\" & "Modules"
    bOk = Z_bIOCreateFolder(sSubFolderName)
    If (Not bOk) Then GoTo ErrorHandler

    sSubFolderName = sFolderName & "\" & "Class Modules"
    bOk = Z_bIOCreateFolder(sSubFolderName)
    If (Not bOk) Then GoTo ErrorHandler

    sSubFolderName = sFolderName & "\" & "Active X"
    bOk = Z_bIOCreateFolder(sSubFolderName)
    If (Not bOk) Then GoTo ErrorHandler


    Dim VBAEditor As VBIDE.VBE
    Set VBAEditor = Application.VBE

    Dim VBProj As VBIDE.VBProject
    Set VBProj = VBAEditor.ActiveVBProject

    Dim VBComp As VBIDE.VBComponent
    For Each VBComp In VBProj.VBComponents
        If (Not VBComp Is Nothing) Then
            bOk = VBE_ExportVBComponent(VBComp, sFolderName)
        End If
    Next VBComp
Exit Sub
ErrorHandler:
    MsgBox _
        Prompt:="Error while exporting source code", _
        Buttons:=vbExclamation
End Sub

Public Function VBE_ExportVBComponent( _
        ByVal VBComp As VBIDE.VBComponent, _
        ByVal sFolderName As String, _
        Optional OverwriteExisting As Boolean = True) As Boolean
'
    VBE_ExportVBComponent = False 'default

    sFolderName = VBE_GetFileSubFolder(sFolderName, VBComp)

    Dim sFileExtension As String
    ' based on module type get the file extension string
    sFileExtension = VBE_GetFileExtension(VBComp:=VBComp)

    Dim sFileName As String
    sFileName = VBComp.Name & sFileExtension

    ' add path checking for \ at the end of sFolderName
    If StrComp(Right(sFolderName, 1), "\", vbBinaryCompare) = 0 Then
        sFileName = sFolderName & sFileName
    Else
        sFileName = sFolderName & "\" & sFileName
    End If

    Dim sFullPathName As String
    sFullPathName = Dir(sFileName, vbNormal + vbHidden + vbSystem)

    'Debug.Print "exporting " & VBComp.Name & " to " & sFileName

    If sFullPathName <> vbNullString Then
        If OverwriteExisting Then
            Kill sFileName
        Else
            Exit Function
        End If
    End If

    VBComp.Export Filename:=sFileName
    VBE_ExportVBComponent = True
End Function

这里是要导入的完整代码

''
' sFolderName  is the full path to a folder which contains subfolders, one for each module type
' sWkbTargetName  is the workbook name created to 'host' the imported modules
Public Sub VBE_ImportModules( _
    ByVal sFolderName As String, _
    ByVal sWkbTargetName As String)
'
    Dim wkbTarget As Excel.Workbook

    Dim bW As Boolean
    bW = (StrComp(sWkbTargetName, ThisWorkbook.Name) <> 0)

    'Get the path to the folder with modules
    Dim bP As Boolean
    bP = Z_bIOExistFolder(sFolderName)

    If (bW And bP) Then
        On Error Resume Next
        Set wkbTarget = Application.Workbooks(sWkbTargetName)
        If (wkbTarget Is Nothing) Then
            Set wkbTarget = Application.Workbooks.Add(sWkbTargetName)
        End If

        If (Not wkbTarget Is Nothing) Then
            If (wkbTarget.VBProject.Protection <> 1) Then
                ''' NOTE: sFolderName where the code modules are located.
                Dim objFSO As Object
                Set objFSO = CreateObject("Scripting.FileSystemObject")


                Dim sSubFolderName As String, asSubFolderName(1 To 5) As String
                asSubFolderName(1) = sFolderName & "\" & "Microsoft Excel Objects" & "\"
                asSubFolderName(2) = sFolderName & "\" & "Forms" & "\"
                asSubFolderName(3) = sFolderName & "\" & "Modules" & "\"
                asSubFolderName(4) = sFolderName & "\" & "Class Modules" & "\"
                asSubFolderName(5) = sFolderName & "\" & "Active X" & "\"
                Dim i As Integer
                For i = LBound(asSubFolderName) To UBound(asSubFolderName)
                    sSubFolderName = asSubFolderName(i)
                    If (objFSO.GetFolder(sSubFolderName).Files.Count > 0) Then

                        'Here we should/could Delete all modules in the target workbook

                        Dim VBComp As VBIDE.VBComponents
                        Set VBComp = wkbTarget.VBProject.VBComponents

                        ''' Import all the code modules in the specified path
                        ''' to the ActiveWorkbook.
                        Dim objFile As Object
                        'objFile = CreateObject("Scripting.File")
                        For Each objFile In objFSO.GetFolder(sSubFolderName).Files

                            If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
                                (objFSO.GetExtensionName(objFile.Name) = "xcls") Or _
                                (objFSO.GetExtensionName(objFile.Name) = "frm") Or _
                                (objFSO.GetExtensionName(objFile.Name) = "bas") _
                            Then
                                'Debug.Print "Importing a new component from : " & objFile.Path
                                VBComp.Import objFile.Path
                            End If

                        Next objFile
                        Debug.Print "Files from '" & sSubFolderName & "' imported"
                    Else
                        Debug.Print _
                            "There are no files to import, " & _
                            "in import Folder '" & sSubFolderName & "'"
                    End If
                Next i
            Else
                Debug.Print _
                    "The VBA in this workbook is protected, " & _
                    "not possible to Import the code"
            End If
        Else
            Debug.Print "Cannot open workbook '" & sWkbTargetName & "'"
        End If
    Else
        If (Not bW) Then _
            Debug.Print _
                "Select another target workbook, " & _
                "Not possible to import code in this workbook "
        If (Not bP) Then _
            Debug.Print "Import Folder '" & sFolderName & "' does not exist"
    End If
End Sub

Public Function VBE_GetFileExtension(VBComp As VBIDE.VBComponent) As String
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns the appropriate file extension based on the Type of
    ' the VBComponent.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Select Case VBComp.Type
        Case vbext_ct_ClassModule
            VBE_GetFileExtension = ".cls"
        Case vbext_ct_Document
            VBE_GetFileExtension = ".xcls"
        Case vbext_ct_MSForm
            VBE_GetFileExtension = ".frm"
        Case vbext_ct_StdModule
            VBE_GetFileExtension = ".bas"
        Case Else
            VBE_GetFileExtension = ".bas"
    End Select
End Function

一些处理文件夹的代码

''
' Z_bIOCreateFolder
Private Function Z_bIOCreateFolder(ByVal sFolderPath As String) As Boolean
    Z_bIOCreateFolder = False ' default
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not Z_bIOExistFolder(sFolderPath) Then
        On Error GoTo IOCreateFolderErrorTrap
        objFSO.CreateFolder sFolderPath ' could there be any error with this, like if the path is really screwed up?
        Z_bIOCreateFolder = True
    End If
Exit Function
IOCreateFolderErrorTrap:
    Call MsgBox("A folder could not be created for the following path: " & sFolderPath & ". Check the path name and try again.")
End Function
''
' Z_bIOExistFolder
Private Function Z_bIOExistFolder(ByVal sFolderPath As String) As Boolean
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
        On Error GoTo IOExistFolderErrorTrap
    Z_bIOExistFolder = objFSO.FolderExists(sFolderPath)
Exit Function
IOExistFolderErrorTrap:
    Call MsgBox("objFSO failed checking: " & sFolderPath)
End Function

结果如下图所示（Feuil *是从工作表代码创建的）。

Answer 1

您可以使用已有的代码并添加一些额外的代码，以将工作表代码转移到工作表或工作簿中！

因为工作表/工作簿代码的 *.cls文件（在您的情况下，Feuil*.cls）无法与类模块区分开根据名称或内容，您必须有一些手动区分它们的方法
- 例如，将它们导出到特殊子文件夹.../workbooks/，.../worksheets/
在导入特定的*.cls文件之前，先创建相应的工作表（使用Worksheets.Add ...）并正确命名（使用myWorksheet.Name = ...）
- 例如Feuil1.cls => Feuil1表
导入，并按照类模块的方式创建（在该模块中，将使用附加的 1命名它们） 因为名称冲突
- 例如Feuil1.cls => Feuil11类模块

将代码本身从类模块复制到工作表/工作簿代码

例如基于CopyModule(...)下的反射代码（或页面上的类似代码）

基于：

With VBComp.CodeModule
    .DeleteLines 1, .CountOfLines
    S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
    .InsertLines 1, S
End With

删除临时导入的课程模块
- 例如Feuil11

导入cls文件并创建工作表

1 个答案: