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

Question

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

16

我正在尝试使用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代码，为什么？

请问有人可以告诉我哪里出了问题吗？

谢谢。

- Princess.Bell

你不应该 .Add(comp) 吗？否则你的代码中就没有 comp 对象的用处了。 - Jeremy Thompson

@JeremyThompson 如果我使用comp，它会给我一个“对象不支持此属性或方法”错误。 - Princess.Bell

使用此处的示例开始。http://www.cpearson.com/excel/vbe.aspx - Tim Williams

@Bing.Wong 请尝试我的下面回答中的代码，看看是否适用于您。 - Shai Rado

5个回答

7

实际上，您根本不需要将任何内容保存到临时文件中。您可以使用目标模块的.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

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

- Chris Melville

一次性使用“AddFromString”似乎不是很好，因为它可能会重复文本“Option Explicit”（如果适当的选项已打开）。在创建后，我首先删除“DestinationModule”中的所有行！ - Leon Rom

@Yogendra因指定可扩展性和宏设置而获得荣誉提名。 - LeftyMaus

7

感谢 Chris Melville 提供的优秀代码，非常感谢。我做了一些小改动并添加了一些注释。

在运行此宏之前，请确保执行以下操作：

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”宏，你会看到源文件宏已复制到目标文件中。

- Yogendra Chandrashekar

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

1

我曾经遇到过很多麻烦，才成功运行之前的答案，因此想发表我的解决方案。此函数用于以编程方式从源工作簿复制模块到新创建的工作簿中，该工作簿也是通过调用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

该函数应该尽可能简单，且相当自我解释。

- Sean Hare

0

你可以尝试以下步骤：

打开两个工作簿
打开VBA开发窗口
下拉菜单中选择模块，将一个模块从一个窗口拖放到另一个窗口

这是为了确保模块名称不重复。如果有包含相同命名函数/子程序的模块，则会发生冲突。

我通常这样做，然后运行调试。看起来效果很好。

P.S. 我会将许多模块复制到我的PERSONAL.xlsb文件中。

- SKT

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Shai Rado · Accepted Answer

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

1.源工作簿（类型为Workbook）。

2.要复制的模块名称（类型为String）。

3.目标工作簿（类型为Workbook）。

CopyModule 代码

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 Code （用于使用文章数据运行此代码的主要Sub代码）：

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