将 VBA 代码从一个工作簿中的工作表复制到另一个工作簿？

Copy VBA code from a Sheet in one workbook to another?

提问by user1283776

I've been using the lines below to compy VBA modules from one workbook to another and I don't know if there is an easier way, but they have been working fine:

我一直在使用下面的行将 VBA 模块从一个工作簿编译到另一个工作簿，我不知道是否有更简单的方法，但它们一直工作正常：

Set srcVba = srcWbk.VBProject
Set srcModule = srcVba.VBComponents(moduleName)

srcModule.Export (path) 'Export from source
trgtVba.VBComponents.Remove VBComponent:=trgtVba.VBComponents.Item(moduleName) 'Remove from target
trgtVba.VBComponents.Import (path) 'Import to target

However now I need to copy VBA code that is in a Sheet, not in a Module. The above method doesn't work for that scenario.

但是现在我需要复制工作表中的 VBA 代码，而不是模块中的代码。上述方法不适用于该场景。

What code can I use to copy VBA code in a sheet from one workbook to another?

我可以使用什么代码将工作簿中的 VBA 代码从一个工作簿复制到另一个工作簿？

回答by Chel

You can't remove and re-import the VBComponent, since that would logically delete the whole worksheet. Instead you have to use CodeModuleto manipulate the text within the component:

您无法删除并重新导入VBComponent，因为这会在逻辑上删除整个工作表。相反，您必须使用CodeModule来操作组件内的文本：

Dim src As CodeModule, dest As CodeModule

Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
    .CodeModule

dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)

回答by dotNET

If anyone else lands here searching for VSTO equivalent of Chel's answer, here it is:

如果其他人在这里搜索与 Chel 的答案相当的 VSTO，这里是：

void CopyMacros(Workbook src, Workbook dest)
{
  var srcModule = src.VBProject.VBComponents.Item(1).CodeModule;
  var destModule = dest.VBProject.VBComponents.Add(Microsoft.Vbe.Interop.vbext_ComponentType.vbext_ct_StdModule);

  destModule.CodeModule.AddFromString(srcModule.Lines[1, srcModule.CountOfLines]);
}

Things to note:

注意事项：

1. You must add reference to Microsoft.Vbe.Interopto do this stuff.
2. I'm adding a new general module to the destination workbook, so I didn't need to call DeleteLines. YMMV.

1. 您必须添加对Microsoft.Vbe.Interop 的引用才能执行此操作。
2. 我正在向目标工作簿添加一个新的通用模块，因此我不需要调用DeleteLines. 天啊。

回答by Pete ACI

Patrick's code does not work for Worksheets (in fact, it will transfer the code to the wrong module). A workaround is to create a new sheet in the destination workbook, and then copy the code over (optionally you can copy and paste the worksheet data/functions/formatting as well).

Patrick 的代码不适用于 Worksheets（实际上，它会将代码转移到错误的模块中）。解决方法是在目标工作簿中创建一个新工作表，然后复制代码（您也可以选择复制和粘贴工作表数据/函数/格式）。

The other thing that doesn't work is UserForms. You can copy the code over, but I'm not aware of any way to copy the actual form (including all the controls) without using the export/import method.

另一件不起作用的是用户窗体。您可以复制代码，但我不知道有什么方法可以在不使用导出/导入方法的情况下复制实际表单（包括所有控件）。

Expanding on Patrick's code:

扩展帕特里克的代码：

'Needs reference to : Microsoft Visual Basic for Application Extensibility 5.3 ,
'or run this code : thisworkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
'from immediate window (ctrl+G) or create a small sub

' What works:   Successfully tranfsers Modules with code and name
'               Copies userform code and name only, but the form is blank (does not transfer controls)
'               Copies code in sheets but no content (optionally add code to copy & paste content)
'               Successfully transfers Classes with code and name

Option Explicit

Public Sub CopyComponentsModules() 'copies sheets/Thisworkbook/Userforms/Modules/Classes to a new workbook
    Dim src As CodeModule, dest As CodeModule
    Dim i&
    Dim WB_Dest As Workbook
    Dim Ref As Reference
    Dim Comp As VBComponent
    Dim sht As Worksheet

    Debug.Print "Starting"

    Set WB_Dest = Application.Workbooks.Add
    On Error Resume Next 'needed for testing if component already exists in destination WorkBook and for cross-references
        For Each Comp In ThisWorkbook.VBProject.VBComponents
            Debug.Print Comp.Name & " - "; Comp.Type
            Err.Clear
            'Set Source code module
            Set src = Comp.CodeModule  'ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule

            'Test if destination component exists first
            i = 0
            i = Len(WB_Dest.VBProject.VBComponents(Comp.Name).Name)
            If i <> 0 Then 'or: if err=0 then
                Set dest = WB_Dest.VBProject.VBComponents(Comp.Name).CodeModule
            Else 'create component
                Err.Clear
                If Comp.Type = 100 Then
                    Set sht = WB_Dest.Sheets.Add
                    Set dest = WB_Dest.VBProject.VBComponents(sht.Name).CodeModule
                    WB_Dest.VBProject.VBComponents(sht.Name).Name = Comp.Name
                    sht.Name = Comp.Name
                Else
                    With WB_Dest.VBProject.VBComponents.Add(Comp.Type)
                        If Err.Number <> 0 Then
                            MsgBox "Error: Component " & Comp.Name & vbCrLf & Err.Description
                        Else
                            .Name = Comp.Name
                            Set dest = .CodeModule
                        End If
                    End With
                End If
            End If

            If Err.Number = 0 Then
                'copy module/Form/Sheet/Class 's code:
                dest.DeleteLines 1, dest.CountOfLines
                dest.AddFromString src.Lines(1, src.CountOfLines)
            End If
        Next Comp

        'Add references as well :
        For Each Ref In ThisWorkbook.VBProject.References
            WB_Dest.VBProject.References.AddFromFile Ref.FullPath
        Next Ref

    Err.Clear: On Error GoTo 0

    Set Ref = Nothing
    Set src = Nothing
    Set dest = Nothing
    Set Comp = Nothing
    Set WB_Dest = Nothing
End Sub

回答by Patrick Lepelletier

This is a compiled code from different sources as well from this very one Post. My contribution is a code that copies ALL your codes from VBE (Sheets/Thisworkbook/Userforms/Modules/Classes) to a new Workbook.

这是来自不同来源的编译代码，也来自这篇文章。我的贡献是将所有代码从 VBE (Sheets/Thisworkbook/Userforms/Modules/Classes) 复制到新工作簿的代码。

i created this , because i have a corrupt workbook and making a code to recover all that isn't corrupt, including code. (this part only recovers code + references) :

我创建了这个，因为我有一个损坏的工作簿并制作了一个代码来恢复所有没有损坏的东西，包括代码。（这部分只恢复代码+引用）：

'needs a reference to : Visual basic for Application Extensibility 5.3 ,
'or run this code : thisworkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
'from immediate window (ctrl+G) or create a small sub

Option Explicit

Sub CopyComponentsModules() 'copies sheets/Thisworkbook/Userforms/Modules/Classes  to a new workbook
Dim src As CodeModule, dest As CodeModule
Dim i&
Dim WB_Dest As Workbook
'Dim sh As Worksheet
Dim Comp As VBComponent

'Set sh = ThisWorkbook.Sheets(1)
'sh.Cells.Clear

Set WB_Dest = Application.Workbooks.Add
On Error Resume Next 'needed for testing if component already exists in destination WorkBook and for cross-references.
For Each Comp In ThisWorkbook.VBProject.VBComponents

            'i = i + 1
            'sh.Cells(i, 1).Value = Comp.Name

            'Set Source code module
            Set src = Comp.CodeModule  'ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule

            'test if destination component exists first
            i = 0: i = Len(WB_Dest.VBProject.VBComponents(Comp.Name).Name)
            If i <> 0 Then 'or: if err=0 then
                Set dest =     WB_Dest.VBProject.VBComponents(Comp.Name).CodeModule
            Else 'create component
                With WB_Dest.VBProject.VBComponents.Add(Comp.Type)
                    .Name = Comp.Name
                    Set dest = .CodeModule
                End With
            End If

            'copy module/Form/Sheet/Class 's code:
            dest.DeleteLines 1, dest.CountOfLines
            dest.AddFromString src.Lines(1, src.CountOfLines)

Next Comp

'Add references as well :
Dim Ref As Reference
For Each Ref In ThisWorkbook.VBProject.References
    'Debug.Print Ref.Name 'Nom
    WB_Dest.VBProject.References.AddFromFile Ref.FullPath
    'Debug.Print Ref.FullPath 'Chemin complet
    'Debug.Print Ref.Description 'Description de la référence
    'Debug.Print Ref.IsBroken 'Indique si la référence est manquante
    'Debug.Print Ref.Major & "." & Ref.Minor 'Version
    'Debug.Print "---"
Next Ref

Err.Clear: On Error GoTo 0

'WB_Dest.Activate

Set Ref = Nothing
Set src = Nothing
Set dest = Nothing
Set Comp = Nothing
Set WB_Dest = Nothing
End Sub