我浏览了以下 URL 中的有趣代码示例 https://www.rondebruin.nl/win/s9/win002.htm
http://www.cpearson.com/excel/vbe.aspx
我已经根据我的需要调整了代码以导出/导入模块，但我仍然无法弄清楚如何导入工作表源代码文件以将其作为工作表代码添加到新工作簿中。当我保存组件以创建工作表源代码文件时，我可以轻松检查VBcomponent类型，但是 无论我使用什么文件扩展名，导入 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* 是从工作表代码创建的）。
