Question

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

请有人告诉我我哪里出错了吗？

谢谢

Answer 1

下面的

Directory.SetCurrentDirectory(System.AppDomain.CurrentDomain‌.BaseDirectory);，收到3个参数：

1.Source Workbook（Sub CopyModule）。

2.Module要复制的名称（作为Workbook）。

3.Target Workbook（String）。

CopyModule代码

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代码（用于使用Post的数据运行此代码）：

Sub

Answer 2

克里斯梅尔维尔的神奇代码，非常感谢，只是我做过的一些小补充＆amp;补充几点评论。

请确保在运行此宏之前完成所有操作。

VB编辑器＆gt;工具＆gt;参考文献＆gt; （检查）Microsoft Visual Basic for Applications Extensibility 5.3
档案 - ＆gt;选项 - ＆gt;信托中心 - ＆gt;信托中心设置 - ＆gt;宏设置 - ＆gt;信任访问VBA项目对象模型。

一旦你做了上面的事情，复制＆amp;粘贴在源文件

中的代码下面

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

现在运行＆＃34; CopyMacrosToExistingWorkbook＆＃34;在目标文件中的宏，您将看到源文件宏复制到目标文件。

Answer 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属性。

Answer 4

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

Answer 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

该功能应该尽可能简单并且相当不言自明。

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

5 个答案:

CopyModule代码