VBA 将模块从一个 Excel 工作簿复制到另一个工作簿答案

【问题标题】：VBA to copy Module from one Excel Workbook to another WorkbookVBA 将模块从一个 Excel 工作簿复制到另一个工作簿
【发布时间】：2016-12-04 07:32:59
【问题描述】：

我正在尝试使用 VBA 将模块从一个 Excel 工作簿复制到另一个。

我的代码：

'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)

由于某种原因，这复制了模块，但没有复制里面的VBA代码，为什么？

请谁能告诉我哪里出错了？

谢谢

【问题讨论】：

你不应该 .Add(comp) 吗？否则代码中的 comp 对象没有用处
@JeremyThompson 如果我使用 comp 它会给我对象不支持此属性或方法错误
使用此处的示例开始。 cpearson.com/excel/vbe.aspx
@Bing.Wong 试试我下面答案中的代码，看看它是否适合你

标签： vba excel

【解决方案1】：

Sub CopyModule下面，接收3个参数：

1.Source Workbook（Workbook）。

2.要复制的模块名称（如String）。

3.目标工作簿（Workbook）。

复制模块代码

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 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

【讨论】：

你必须通过导入/导出来做吗？
没有查看其他实现此需求的方法，我已经运行这段代码（它的不同版本）一段时间了，它给了我需要的结果
别担心，只是好奇文件似乎有很多开销，它确实有一个 Add 方法
随时发送指向另一个更简单、更快的解决方案的链接，随时乐于学习和改进
@Princess.Bell 我从来没有收到你对这个答案的反馈，它对你有用吗？

【解决方案2】：

Chris Melville 的神奇代码，非常感谢，我做了一些小的补充并添加了一些 cmets。

请确保在运行此宏之前完成以下操作。

VB 编辑器 > 工具 > 参考 >（检查）Microsoft Visual Basic for Applications Extensibility 5.3
文件 -> 选项 -> 信任中心 -> 信任中心设置 -> 宏设置 -> 信任对 VBA 项目对象模型的访问。

完成上述操作后，将以下代码复制并粘贴到源文件中

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

现在在目标文件中运行“CopyMacrosToExistingWorkbook”宏，您将看到源文件宏复制到目标文件。

【讨论】：

在创建后立即使用AddFromString 似乎不太好，因为如果适当的选项打开，这可能会重复文本Option Explicit。我首先（创建后）你应该删除新创建的模块中的所有行：DestinationModule.DeleteLines 1, DestinationModule.CountOfLines

【解决方案3】：

实际上，您根本不需要将任何内容保存到临时文件中。您可以使用目标模块的.AddFromString method 来添加源的字符串值。试试下面的代码：

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

应该是不言自明的！ .AddFomString 方法只接受一个字符串变量。所以为了得到它，我们使用源模块的 .Lines 属性。第一个参数 (1) 是起始行，第二个参数是结束行号。在这种情况下，我们想要所有的行，所以我们使用.CountOfLines 属性。

【讨论】：

立即使用 'AddFromString' 似乎不好，因为它可能会重复文本“Option Explicit”（如果适当的选项为 ON）。我首先（创建后）我删除了“DestinationModule”中的所有行！
@Yogendra 因指定可扩展性和宏设置而获得荣誉奖。

【解决方案4】：

Shai Rado 的导出/导入方法的优点是可以拆分它们，即将源工作簿中的模块作为一个步骤导出，然后将它们导入到多个目标文件中！

【讨论】：

复制 VBA 代码的答案是什么？
Shai Rado 的方法是使用导出/导入而不是 .Add 方法。它还导入内容，模块内的代码。

【解决方案5】：

我在获得以前的答案时遇到了很多麻烦，所以我想我会发布我的解决方案。此函数用于以编程方式将模块从源工作簿复制到新创建的工作簿，该工作簿也是通过调用 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

希望该函数尽可能简单且不言自明。

【讨论】：