导入CLS文件并创建工作表 [英] Import a cls files and create a sheet

查看：73 发布时间：2021/5/5 19:45:07 excel vbide vba

本文介绍了导入CLS文件并创建工作表的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我浏览了以下网址中有趣的代码示例

解决方案

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

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

  将代码本身从类模块复制到工作表/工作簿代码 
例如基于  CopyModule(...) (或页面上的类似代码)
 基于:
 使用VBComp.CodeModule.DeleteLines 1，.CountOfLinesS = TempVBComp.CodeModule.Lines(1，TempVBComp.CodeModule.CountOfLines).InsertLines 1，S结束于

删除临时导入的类模块例如 Feuil11

I went through interesting code examples found at the following URLS https://www.rondebruin.nl/win/s9/win002.htm



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

I have adapted the code to export/import modules to my needs still I cannot figure out how I could import a sheet source code file to add it to a new workbook as sheet code. I can easily check for the VBcomponent type when I save the component to create a sheet source code file but the import VBcomponent  method will wrongly create a new class module after reading the created file no matter what file extension I use. The same problem occurs with ThisWorkbook source code file.
The component type and file extension is obtained from this piece of code 
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 
I know it is possible to edit sheet and workbook source code using VBA but I am afraid it won't be very efficient.

Here the full code the export 
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
Here the full code to import
''
' 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
some code to deal with folders
''
' 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
The result as displayed in the image below (Feuil* are created from sheet code).

 解决方案 
You could use the code you have already and add some extra code to transfer the sheet code into your sheets or workbook!

since the *.cls files for your sheet/workbook code (in your case Feuil*.cls) cannot be differentiated from class modules by name or content, you have to have some way to differentiate them manually


e.g. exporting them into special subfolders .../workbooks/, .../worksheets/

before you import a specific *.cls file you create the according sheet first (with Worksheets.Add ...) and name it correctly (with myWorksheet.Name = ...)


e.g. Feuil1.cls => Feuil1 sheet

import it the way you did and let it be created as a class module (where they will be named with an additional 1 suffixed because of the name conflict


e.g. Feuil1.cls => Feuil11 class module

copy the code itself from the class module to the sheet/workbook code


e.g. based on the reflection code under CopyModule(...)  (or similar code on the page)
based on:
With VBComp.CodeModule
    .DeleteLines 1, .CountOfLines
    S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
    .InsertLines 1, S
End With


delete the temporary imported class module


e.g. Feuil11



                        
这篇关于导入CLS文件并创建工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！


                    
                        查看全文

导入CLS文件并创建工作表 [英] Import a cls files and create a sheet

问题描述

相关文章

其他开发最新文章

热门教程

热门工具

登录关闭

导入CLS文件并创建工作表 [英] Import a cls files and create a sheet

问题描述

相关文章

其他开发最新文章

热门教程

热门工具

登录 关闭

登录关闭