Excel 将所有VBA代码从工作簿复制到另一个工作簿
我搜索了很多，找到了很多导出VBA代码模块的VBA代码，但我需要的是有点不同。 我有一个大型项目，在标准模块、工作表模块和工作簿模块中有很多VBA代码。所有这些都有VBA代码，还有另一个工作簿（“New.xlsm”），我需要将所有这些VBA代码复制到其中。 但在导出这些VBA代码之前，我需要从任何模块的任何代码中清除“New.xlsm”，或者删除任何现有模块并清除所有内容。然后将VBA代码复制到“New.xlsm” 我有这段代码可以导出所有VBE组件，但这可能只是一个步骤Excel 将所有VBA代码从工作簿复制到另一个工作簿,excel,vba,Excel,Vba,我搜索了很多，找到了很多导出VBA代码模块的VBA代码，但我需要的是有点不同。 我有一个大型项目，在标准模块、工作表模块和工作簿模块中有很多VBA代码。所有这些都有VBA代码，还有另一个工作簿（“New.xlsm”），我需要将所有这些VBA代码复制到其中。 但在导出这些VBA代码之前，我需要从任何模块的任何代码中清除“New.xlsm”，或者删除任何现有模块并清除所有内容。然后将VBA代码复制到“New.xlsm” 我有这段代码可以导出所有VBE组件，但这可能只是一个步骤 Sub Export_
Sub Export_All_VBE_Components()
'References: Microsoft Visual Basic for Applications Extensibility 5.3
'---------------------------------------------------------------------
Dim vbComp As VBIDE.VBComponent
Dim destDir As String
Dim fName As String
Dim ext As String
If ActiveWorkbook.Path = "" Then MsgBox "You Must First Save This Workbook Somewhere So That It Has A Path.", , "Error": Exit Sub
destDir = ActiveWorkbook.Path & "\" & ActiveWorkbook.name & " Modules"
If Dir(destDir, vbDirectory) = vbNullString Then MkDir destDir
For Each vbComp In ActiveWorkbook.VBProject.VBComponents
If vbComp.CodeModule.CountOfLines > 0 Then
Select Case vbComp.Type
Case vbext_ct_ClassModule: ext = ".cls"
Case vbext_ct_Document: ext = ".cls"
Case vbext_ct_StdModule: ext = ".bas"
Case vbext_ct_MSForm: ext = ".frm"
Case Else: ext = vbNullString
End Select
If ext <> vbNullString Then
fName = destDir & "\" & vbComp.name & ext
If Dir(fName, vbNormal) <> vbNullString Then Kill (fName)
vbComp.Export (fName)
End If
End If
Next vbComp
End Sub
Sub Copy_module()
Dim varModule, wbkSource As Workbook, wbkTarget As Workbook, strModule As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wbkSource = ThisWorkbook
Set wbkTarget = Application.Workbooks("Original.xlsm")
With wbkTarget.VBProject.VBComponents
For Each varModule In Array("Module1", "Module2")
strModule = ThisWorkbook.Path & "\" & varModule & ".bas"
wbkSource.VBProject.VBComponents(varModule).Export Filename:=strModule
On Error Resume Next
.Remove VBComponent:=.Item(varModule)
On Error GoTo 0
.Import Filename:=ThisWorkbook.Path & "\" & varModule & ".bas"
Kill strModule
Next varModule
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub CopyWorksheetsModules()
Dim src, dest, wb As Workbook, ws As Worksheet
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
Set src = ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule
Set wb = Workbooks("Original.xlsm")
Set dest = wb.VBProject.VBComponents(ws.CodeName).CodeModule
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Next ws
On Error GoTo 0
End Sub
我还没有测试过这段代码，但我发现： 要将模块从一个工作簿复制到另一个工作簿，请执行以下操作： 要从工作簿中删除所有代码，请执行以下操作：
希望能有所帮助。我还没有测试过这段代码，但我发现： 要将模块从一个工作簿复制到另一个工作簿，请执行以下操作： 要从工作簿中删除所有代码，请执行以下操作：
希望对您有所帮助。这是我用来导入/导出模块的代码。导出模块将删除保存它们的文件夹中的所有当前文件。导入模块将在导入之前删除所有模块。请注意：
ElseIf Not VBComp.Name Like "*Modulos*" Then
VBProj.VBComponents.Remove VBComp
End If
ImportarModulosExportarModulosOption Explicit
Public Sub ExportModules()
Dim bExport As Boolean
Dim wkbSource As Excel.Workbook
Dim szSourceWorkbook As String
Dim szExportPath As String
Dim szFileName As String
Dim cmpComponent As VBIDE.VBComponent
''' The code modules will be exported in a folder named.
''' VBAProjectFiles in the Documents folder.
''' The code below create this folder if it not exist
''' or delete all files in the folder if it exist.
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Export Folder not exist"
Exit Sub
End If
On Error Resume Next
Kill FolderWithVBAProjectFiles & "\*.*"
On Error GoTo 0
''' NOTE: This workbook must be open in Excel.
szSourceWorkbook = ActiveWorkbook.Name
Set wkbSource = Application.Workbooks(szSourceWorkbook)
If wkbSource.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to export the code"
Exit Sub
End If
szExportPath = FolderWithVBAProjectFiles & "\"
For Each cmpComponent In wkbSource.VBProject.VBComponents
bExport = True
szFileName = cmpComponent.Name
''' Concatenate the correct filename for export.
Select Case cmpComponent.Type
Case vbext_ct_ClassModule
szFileName = szFileName & ".cls"
Case vbext_ct_MSForm
szFileName = szFileName & ".frm"
Case vbext_ct_StdModule
szFileName = szFileName & ".bas"
Case vbext_ct_Document
''' This is a worksheet or workbook object.
''' Don't try to export.
bExport = False
End Select
If bExport Then
''' Export the component to a text file.
cmpComponent.Export szExportPath & szFileName
''' remove it from the project if you want
'''wkbSource.VBProject.VBComponents.Remove cmpComponent
End If
Next cmpComponent
Dim wb As Workbook, ws As Worksheet, LastRow As Long
Set wb = Workbooks.Open("Z:\Planificacion-WFM\Planificacion Telefonica\Código\Log.xlsx")
Set ws = wb.Sheets(1)
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(LastRow, 1) = Application.UserName
ws.Cells(LastRow, 2) = Format(Now(), "hh:mm:ss")
ws.Cells(LastRow, 3) = Format(Now(), "dd/mm/yyyy")
wb.Close Savechanges:=True
MsgBox "Export is ready"
End Sub
Function FolderWithVBAProjectFiles() As String
Dim WshShell As Object
Dim FSO As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("scripting.filesystemobject")
SpecialPath = "Z:\Planificacion-WFM\Planificacion Telefonica\Código"
If Right(SpecialPath, 1) <> "\" Then
SpecialPath = SpecialPath & "\"
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
On Error Resume Next
MkDir SpecialPath & "VBAProjectFiles"
On Error GoTo 0
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
Else
FolderWithVBAProjectFiles = "Error"
End If
End Function
这是我用来导入/导出模块的代码。导出模块将删除保存它们的文件夹中的所有当前文件。导入模块将在导入之前删除所有模块。请注意：
ElseIf Not VBComp.Name Like "*Modulos*" Then
VBProj.VBComponents.Remove VBComp
End If
ImportarModulosExportarModulosOption Explicit
Public Sub ExportModules()
Dim bExport As Boolean
Dim wkbSource As Excel.Workbook
Dim szSourceWorkbook As String
Dim szExportPath As String
Dim szFileName As String
Dim cmpComponent As VBIDE.VBComponent
''' The code modules will be exported in a folder named.
''' VBAProjectFiles in the Documents folder.
''' The code below create this folder if it not exist
''' or delete all files in the folder if it exist.
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Export Folder not exist"
Exit Sub
End If
On Error Resume Next
Kill FolderWithVBAProjectFiles & "\*.*"
On Error GoTo 0
''' NOTE: This workbook must be open in Excel.
szSourceWorkbook = ActiveWorkbook.Name
Set wkbSource = Application.Workbooks(szSourceWorkbook)
If wkbSource.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to export the code"
Exit Sub
End If
szExportPath = FolderWithVBAProjectFiles & "\"
For Each cmpComponent In wkbSource.VBProject.VBComponents
bExport = True
szFileName = cmpComponent.Name
''' Concatenate the correct filename for export.
Select Case cmpComponent.Type
Case vbext_ct_ClassModule
szFileName = szFileName & ".cls"
Case vbext_ct_MSForm
szFileName = szFileName & ".frm"
Case vbext_ct_StdModule
szFileName = szFileName & ".bas"
Case vbext_ct_Document
''' This is a worksheet or workbook object.
''' Don't try to export.
bExport = False
End Select
If bExport Then
''' Export the component to a text file.
cmpComponent.Export szExportPath & szFileName
''' remove it from the project if you want
'''wkbSource.VBProject.VBComponents.Remove cmpComponent
End If
Next cmpComponent
Dim wb As Workbook, ws As Worksheet, LastRow As Long
Set wb = Workbooks.Open("Z:\Planificacion-WFM\Planificacion Telefonica\Código\Log.xlsx")
Set ws = wb.Sheets(1)
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(LastRow, 1) = Application.UserName
ws.Cells(LastRow, 2) = Format(Now(), "hh:mm:ss")
ws.Cells(LastRow, 3) = Format(Now(), "dd/mm/yyyy")
wb.Close Savechanges:=True
MsgBox "Export is ready"
End Sub
Function FolderWithVBAProjectFiles() As String
Dim WshShell As Object
Dim FSO As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("scripting.filesystemobject")
SpecialPath = "Z:\Planificacion-WFM\Planificacion Telefonica\Código"
If Right(SpecialPath, 1) <> "\" Then
SpecialPath = SpecialPath & "\"
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
On Error Resume Next
MkDir SpecialPath & "VBAProjectFiles"
On Error GoTo 0
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
Else
FolderWithVBAProjectFiles = "Error"
End If
End Function
非常感谢Damian在本主题中做出的巨大贡献。我非常感谢他的帮助。 这是我从不同资源收集的最终代码，代码将分两步执行。 代码将放在“New.xlsm”中，其中包含我需要复制的所有模块（源工作簿），并将所有模块（所有类型）复制到“original.xlsm”（目标工作簿）
'参考：Microsoft Visual Basic for Applications Extensionability 5.3
'---------------------------------------------------------------------
公共目录作为字符串
常量destWorkbook为String=“Original.xlsm”
子P1_导出所有_VBE_组件（）
将vbComp作为VBIDE.VBComponent进行调整，将fName作为字符串，将ext作为字符串
如果ThisWorkbook.Path=”“，则MsgBox“您必须首先将此工作簿保存在某个位置，以便它具有路径。”，“错误”：退出子文件夹
destDir=ThisWorkbook.Path&“\”和ThisWorkbook.Name&“模块”
如果Dir（destDir，vbDirectory）=vbNullString，则MkDir destDir
对于此工作簿中的每个vbComp.VBProject.VBComponents
如果vbComp.CodeModule.CountOfLines>0，则
选择案例vbComp.Type
案例vbext\U ct\U类模块：ext=“.cls”
案例vbext\u ct\u std模块：ext=“.bas”
案例vbext\u ct\u MSForm:ext=“.frm”
Case Else:ext=vbNullString
结束选择
如果是ext vbNullString，则
fName=destDir&“\”&vbComp.Name&ext
如果Dir（fName，vbNormal）vbNullString，则Kill（fName）
vbComp.Export（fName）
如果结束
如果结束
下一个vbComp
端接头
子P2\u删除\u宏\u复制\u所有\u模块（）
Dim src、dest、wbTarget作为工作簿、ws作为工作表、fso作为对象、oFile作为对象、sCode作为字符串
Application.ScreenUpdating=False
Set wbTarget=Application.workbook（destWorkbook）
如果wbTarget.VBProject.Protection=1，则MsgBox“目标工作簿中的VBA受保护”，VBEQUOTE:Exit Sub
设置fso=CreateObject（“Scripting.FileSystemObject”）
如果fso.GetFolder（destDir.Files.Count）为0，则MsgBox“没有要导出的文件”，VBEQUOTION:Exit Sub
RemoveAllMacrosWBTarget
对于fso.GetFolder（destDir）.Files中的每个文件
如果fso.GetExtensionName（oFile.Name）=“cls”或fso.GetExtensionName（oFile.Name）=“bas”或fso.GetExtensionName（oFile.Name）=“frm”，则
wbTarget.VBProject.VBComponents.Import of ile.Path
如果结束
下一个文件
出错时继续下一步
对于此工作簿中的每个ws。工作表
设置src=thiswoolk.VBProject.VBComponents（ws.CodeName.CodeModule）
设置dest=wbTarget.VBProject.VBComponents（ws.CodeName.CodeModule）
dest.AddFromString src.line（1，src.countofline）
下一个ws
错误转到0
使用ThisWorkbook.VBProject.VBComponents（“ThisWorkbook”）.CodeModule
sCode=.line（1，.countofline）
以
wbTarget.VBProject.VBComponents（“此工作簿”）.CodeModule.AddFromString sCode
Application.ScreenUpdating=True
端接头
子RemoveAllMacros（wbk作为工作簿）
将vbCode作为对象，vbComp作为对象，vbProj作为对象
设置vbProj=wbk.VBProject
用vbProj
对于.vbComp中的每个vbComp组件
选择案例vbComp.Type
案例1、2、3
vbProj.VBComponents.Remove vbComp
案例100
设置vbCode=vbComp.CodeModule
vbCode.DeleteLines
Option Explicit
Public Sub ExportModules()
Dim bExport As Boolean
Dim wkbSource As Excel.Workbook
Dim szSourceWorkbook As String
Dim szExportPath As String
Dim szFileName As String
Dim cmpComponent As VBIDE.VBComponent
''' The code modules will be exported in a folder named.
''' VBAProjectFiles in the Documents folder.
''' The code below create this folder if it not exist
''' or delete all files in the folder if it exist.
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Export Folder not exist"
Exit Sub
End If
On Error Resume Next
Kill FolderWithVBAProjectFiles & "\*.*"
On Error GoTo 0
''' NOTE: This workbook must be open in Excel.
szSourceWorkbook = ActiveWorkbook.Name
Set wkbSource = Application.Workbooks(szSourceWorkbook)
If wkbSource.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to export the code"
Exit Sub
End If
szExportPath = FolderWithVBAProjectFiles & "\"
For Each cmpComponent In wkbSource.VBProject.VBComponents
bExport = True
szFileName = cmpComponent.Name
''' Concatenate the correct filename for export.
Select Case cmpComponent.Type
Case vbext_ct_ClassModule
szFileName = szFileName & ".cls"
Case vbext_ct_MSForm
szFileName = szFileName & ".frm"
Case vbext_ct_StdModule
szFileName = szFileName & ".bas"
Case vbext_ct_Document
''' This is a worksheet or workbook object.
''' Don't try to export.
bExport = False
End Select
If bExport Then
''' Export the component to a text file.
cmpComponent.Export szExportPath & szFileName
''' remove it from the project if you want
'''wkbSource.VBProject.VBComponents.Remove cmpComponent
End If
Next cmpComponent
Dim wb As Workbook, ws As Worksheet, LastRow As Long
Set wb = Workbooks.Open("Z:\Planificacion-WFM\Planificacion Telefonica\Código\Log.xlsx")
Set ws = wb.Sheets(1)
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(LastRow, 1) = Application.UserName
ws.Cells(LastRow, 2) = Format(Now(), "hh:mm:ss")
ws.Cells(LastRow, 3) = Format(Now(), "dd/mm/yyyy")
wb.Close Savechanges:=True
MsgBox "Export is ready"
End Sub
Function FolderWithVBAProjectFiles() As String
Dim WshShell As Object
Dim FSO As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("scripting.filesystemobject")
SpecialPath = "Z:\Planificacion-WFM\Planificacion Telefonica\Código"
If Right(SpecialPath, 1) <> "\" Then
SpecialPath = SpecialPath & "\"
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
On Error Resume Next
MkDir SpecialPath & "VBAProjectFiles"
On Error GoTo 0
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
Else
FolderWithVBAProjectFiles = "Error"
End If
End Function
Option Explicit
Public Sub ImportModules()
Dim wkbTarget As Excel.Workbook
Dim objFSO As Scripting.FileSystemObject
Dim objFile As Scripting.File
Dim szTargetWorkbook As String
Dim szImportPath As String
Dim szFileName As String
Dim cmpComponents As VBIDE.VBComponents
'
' If ActiveWorkbook.Name = ThisWorkbook.Name Then
' MsgBox "Select another destination workbook" & _
' "Not possible to import in this workbook "
' Exit Sub
' End If
'Get the path to the folder with modules
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Import Folder not exist"
Exit Sub
End If
''' NOTE: This workbook must be open in Excel.
szTargetWorkbook = ActiveWorkbook.Name
Set wkbTarget = Application.Workbooks(szTargetWorkbook)
If wkbTarget.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to Import the code"
Exit Sub
End If
''' NOTE: Path where the code modules are located.
szImportPath = FolderWithVBAProjectFiles & "\"
Set objFSO = New Scripting.FileSystemObject
If objFSO.GetFolder(szImportPath).Files.Count = 0 Then
MsgBox "There are no files to import"
Exit Sub
End If
'Delete all modules/Userforms from the ActiveWorkbook
Call DeleteVBAModulesAndUserForms
Set cmpComponents = wkbTarget.VBProject.VBComponents
''' Import all the code modules in the specified path
''' to the ActiveWorkbook.
For Each objFile In objFSO.GetFolder(szImportPath).Files
If objFile.Name Like "*Modulos*" Then GoTo Siguiente
If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
(objFSO.GetExtensionName(objFile.Name) = "frm") Or _
(objFSO.GetExtensionName(objFile.Name) = "bas") Then
cmpComponents.Import objFile.Path
End If
Siguiente:
Next objFile
MsgBox "Módulos actualizados"
End Sub
Function DeleteVBAModulesAndUserForms()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
If VBComp.Type = vbext_ct_Document Then
'Thisworkbook or worksheet module
'We do nothing
ElseIf Not VBComp.Name Like "*Modulos*" Then
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
End Function
'References: Microsoft Visual Basic for Applications Extensibility 5.3
'---------------------------------------------------------------------
Public destDir As String
Const destWorkbook As String = "Original.xlsm"
Sub P1_Export_All_VBE_Components()
Dim vbComp As VBIDE.VBComponent, fName As String, ext As String
If ThisWorkbook.Path = "" Then MsgBox "You Must First Save This Workbook Somewhere So That It Has A Path.", , "Error": Exit Sub
destDir = ThisWorkbook.Path & "\" & ThisWorkbook.Name & " Modules"
If Dir(destDir, vbDirectory) = vbNullString Then MkDir destDir
For Each vbComp In ThisWorkbook.VBProject.VBComponents
If vbComp.CodeModule.CountOfLines > 0 Then
Select Case vbComp.Type
Case vbext_ct_ClassModule: ext = ".cls"
Case vbext_ct_StdModule: ext = ".bas"
Case vbext_ct_MSForm: ext = ".frm"
Case Else: ext = vbNullString
End Select
If ext <> vbNullString Then
fName = destDir & "\" & vbComp.Name & ext
If Dir(fName, vbNormal) <> vbNullString Then Kill (fName)
vbComp.Export (fName)
End If
End If
Next vbComp
End Sub
Sub P2_Remove_Macros_Copy_All_Modules()
Dim src, dest, wbTarget As Workbook, ws As Worksheet, fso As Object, oFile As Object, sCode As String
Application.ScreenUpdating = False
Set wbTarget = Application.Workbooks(destWorkbook)
If wbTarget.VBProject.Protection = 1 Then MsgBox "The VBA In Target Workbook Is Protected", vbExclamation: Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.GetFolder(destDir).Files.Count = 0 Then MsgBox "There Are No Files To Export", vbExclamation: Exit Sub
RemoveAllMacros wbTarget
For Each oFile In fso.GetFolder(destDir).Files
If fso.GetExtensionName(oFile.Name) = "cls" Or fso.GetExtensionName(oFile.Name) = "bas" Or fso.GetExtensionName(oFile.Name) = "frm" Then
wbTarget.VBProject.VBComponents.Import oFile.Path
End If
Next oFile
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
Set src = ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule
Set dest = wbTarget.VBProject.VBComponents(ws.CodeName).CodeModule
dest.AddFromString src.Lines(1, src.CountOfLines)
Next ws
On Error GoTo 0
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
sCode = .Lines(1, .CountOfLines)
End With
wbTarget.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString sCode
Application.ScreenUpdating = True
End Sub
Sub RemoveAllMacros(wbk As Workbook)
Dim vbCode As Object, vbComp As Object, vbProj As Object
Set vbProj = wbk.VBProject
With vbProj
For Each vbComp In .VBComponents
Select Case vbComp.Type
Case 1, 2, 3
vbProj.VBComponents.Remove vbComp
Case 100
Set vbCode = vbComp.CodeModule
vbCode.DeleteLines 1, vbCode.CountOfLines
End Select
Next vbComp
End With
End Sub