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

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了将一个工作簿中的工作表中的VBA代码复制到另一个工作簿?相关的知识,希望对你有一定的参考价值。

我一直在使用下面的行将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

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

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

答案

您无法删除并重新导入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)
另一答案

如果有人在这里寻找VSTO相当于Chel的答案,这里是:

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]);
}

注意事项:

  1. 您必须添加对Microsoft.Vbe.Interop的引用才能执行此操作。
  2. 我正在向目标工作簿添加一个新的通用模块,所以我不需要调用DeleteLines。因人而异。
另一答案

Patrick的代码不适用于Worksheets(事实上,它会将代码传输到错误的模块)。解决方法是在目标工作簿中创建新工作表,然后复制代码(也可以复制并粘贴工作表数据/函数/格式)。

另一件不起作用的是UserForms。您可以复制代码,但我不知道如何在不使用导出/导入方法的情况下复制实际表单(包括所有控件)。

扩展Patrick的代码:

'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
另一答案

这是来自不同来源的编译代码以及这一个帖子。我的贡献是将所有代码从VBE(Sheets / Thisworkbook / Userforms / Modules / Classes)复制到新工作簿的代码。

我创建了这个,因为我有一个损坏的工作簿,并制作代码来恢复所有没有损坏的代码,包括代码。 (此部分仅恢复代码+引用):

'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

以上是关于将一个工作簿中的工作表中的VBA代码复制到另一个工作簿?的主要内容,如果未能解决你的问题,请参考以下文章

如何用VBA把一个工作簿中的工作表内容复制到另一个汇总工作簿里面的指定的工作表里面去?

如何将文件夹中的多个源工作簿中的数据复制到另一个工作簿,然后另存为新工作簿

VBA 复制工作表至新的工作簿中的工作表

Excel VBA - 循环遍历多个文件夹中的文件,复制范围,粘贴到此工作簿中

Excel VBA在生成副本的工作表中插入本工作簿中的VBA模块代码

Excel VBA 宏将复制一系列单元格并粘贴到另一个工作簿中