问题
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).
回答1:
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
*.clsfiles for your sheet/workbook code (in your caseFeuil*.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/
- e.g. exporting them into special subfolders
before you import a specific
*.clsfile you create the according sheet first (withWorksheets.Add ...) and name it correctly (withmyWorksheet.Name = ...)- e.g.
Feuil1.cls=>Feuil1sheet
- e.g.
- import it the way you did and let it be created as a class module (where they will be named with an additional
1suffixed because of the name conflict- e.g.
Feuil1.cls=>Feuil11class module
- e.g.
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
- e.g.
来源：https://stackoverflow.com/questions/51029134/import-a-cls-files-and-create-a-sheet