VBA 将模块从一个 Excel 工作簿复制到另一个工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/40956465/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA to copy Module from one Excel Workbook to another Workbook
提问by Princess.Bell
I am trying to copy a module from one excel workbook to another using VBA.
我正在尝试使用 VBA 将模块从一个 Excel 工作簿复制到另一个。
My Code:
我的代码：
'Copy Macros
Dim comp As Object
Set comp = ThisWorkbook.VBProject.VBComponents("Module2")
Set Target = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm").VBProject.VBComponents.Add(1)
For some reason, this copies the module, but does not copy the VBA code inside, why?
由于某种原因，这复制了模块，但没有复制里面的VBA代码，为什么？
Please can someone show me where i am going wrong?
请有人告诉我我哪里出错了？
Thanks
谢谢
回答by Shai Rado
Sub CopyModulebelow, receives 3 parameters:
Sub CopyModule下面，接收 3 个参数：
1.Source Workbook (as Workbook).
1.源工作簿（如Workbook）。
2.Module Name to Copy (as String).
2.要复制的模块名称（如String）。
3.Target Workbook (as Workbook).
3.目标工作簿（如Workbook）。
CopyModule Code
复制模块代码
Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)
' Description: copies a module from one workbook to another
' example: CopyModule Workbooks(ThisWorkbook), "Module2",
' Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
' Notes: If Module to be copied already exists, it is removed first,
' and afterwards copied
Dim strFolder As String
Dim strTempFile As String
Dim FName As String
If Trim(strModuleName) = vbNullString Then
Exit Sub
End If
If TargetWB Is Nothing Then
MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
Exit Sub
End If
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
' create temp file and copy "Module2" into it
strFolder = strFolder & "\"
strTempFile = strFolder & "~tmpexport.bas"
On Error Resume Next
FName = Environ("Temp") & "\" & strModuleName & ".bas"
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
MsgBox "Error copying module " & strModuleName & " from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
Exit Sub
End If
End If
' remove "Module2" if already exits in destination workbook
With TargetWB.VBProject.VBComponents
.Remove .Item(strModuleName)
End With
' copy "Module2" from temp file to destination workbook
SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
TargetWB.VBProject.VBComponents.Import strTempFile
Kill strTempFile
On Error GoTo 0
End Sub
Main SubCode(for running this code with the Post's data):
主要Sub代码（用于使用 Post 数据运行此代码）：
Option Explicit
Public Sub Main()
Dim WB1 As Workbook
Dim WB2 As Workbook
Set WB1 = ThisWorkbook
Set WB2 = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
Call CopyModule(WB1, "Module2", WB2)
End Sub
回答by Yogendra
Fantastic Code by Chris Melville, Thanks a ton, just a few small addition which i did & added few comments.
Chris Melville 编写的神奇代码，非常感谢，只是我所做的一些小补充并添加了一些评论。
Just make sure, following things are done before running this macro.
请确保在运行此宏之前已完成以下操作。
VB Editor > Tools > References > (Check) Microsoft Visual Basic for Applications Extensibility 5.3
File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings -> Trust Access to the VBA Project object model.
VB 编辑器 > 工具 > 参考 >（检查）Microsoft Visual Basic for Applications Extensibility 5.3
文件 -> 选项 -> 信任中心 -> 信任中心设置 -> 宏设置 -> 对 VBA 项目对象模型的信任访问。
Once you do above thing, copy & paste below code in Source File
完成上述操作后，将下面的代码复制并粘贴到源文件中
Sub CopyMacrosToExistingWorkbook()
'Copy this VBA Code in SourceMacroModule, & run this macro in Destination workbook by pressing Alt+F8, the whole module gets copied to destination File.
Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
Set SourceVBProject = ThisWorkbook.VBProject
Dim NewWb As Workbook
Set NewWb = ActiveWorkbook ' Or whatever workbook object you have for the destination
Set DestinationVBProject = NewWb.VBProject
'
Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
' Add a new module to the destination project
Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
'
With SourceModule
DestinationModule.AddFromString .Lines(1, .CountOfLines)
End With
End Sub
Now run the "CopyMacrosToExistingWorkbook" macro in destination file, you will see the source file macro copied to destination file.
现在在目标文件中运行“CopyMacrosToExistingWorkbook”宏，您将看到源文件宏复制到目标文件。
回答by Chris Melville
Actually, you don't need to save anything to a temporary file at all. You can use the .AddFromStringmethodof the destination module to add the string value of the source. Try the following code:
实际上，您根本不需要将任何内容保存到临时文件中。您可以使用目标模块的.AddFromString方法添加源的字符串值。试试下面的代码：
Sub CopyModule()
Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
Set SourceVBProject = ThisWorkbook.VBProject
Dim NewWb As Workbook
Set NewWb = Workbooks.Add ' Or whatever workbook object you have for the destination
Set DestinationVBProject = NewWb.VBProject
'
Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
' Add a new module to the destination project
Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
'
With SourceModule
DestinationModule.AddFromString .Lines(1, .CountOfLines)
End With
End Sub
Should be self-explanatory! The .AddFomStringmethod simply takes a string variable. So in order to get that, we use the .Lines property of the source module. The first argument (1) is the start line, and the second argument is the end line number. In this case, we want all the lines, so we use the .CountOfLinesproperty.
应该不言自明！该.AddFomString方法只需要一个字符串变量。所以为了得到它，我们使用源模块的 .Lines 属性。第一个参数 ( 1) 是开始行，第二个参数是结束行号。在这种情况下，我们想要所有的行，所以我们使用.CountOfLines属性。
回答by Joe Phi
Shai Rado's method of export/import has the advantage that you can split them, i.e. export the module from the source workbook as one step and then import them into multiple target files!
Shai Rado 的导出/导入方法的优点是可以拆分它们，即将源工作簿中的模块作为一个步骤导出，然后将它们导入到多个目标文件中！
回答by Sean Hare
I had a lot of trouble getting the previous answers to work, so I thought I'd post my solution. This function is used to programmatically copy modules from a source workbook to a newly created workbook that was also created programmatically with a call to worksheet.copy. What doesn't happen when a worksheet is copied to a new workbook is the transfer of the macros that the worksheet depends upon. This procedure iterates through all modules in the source workbook and copies them into the new one. What's more is that it actually worked for me in Excel 2016.
我在获得以前的答案时遇到了很多麻烦，所以我想我会发布我的解决方案。此函数用于以编程方式将模块从源工作簿复制到新创建的工作簿，该工作簿也是通过调用 worksheet.copy 以编程方式创建的。将工作表复制到新工作簿时不会发生的是工作表所依赖的宏的传输。此过程遍历源工作簿中的所有模块并将它们复制到新的模块中。更重要的是，它实际上在 Excel 2016 中对我有用。
Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)
Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
Dim sText As String, nType As Long
For Each vbcompSource In wbSource.VBProject.VBComponents
nType = vbcompSource.Type
If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy
Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
vbcompTarget.CodeModule.AddFromString (sText)
vbcompTarget.Name = vbcompSource.Name
End If
Next vbcompSource
End Sub
The function should hopefully be as simple as possible and fairly self-explanatory.
该函数应该尽可能简单并且不言自明。
