将一个工作簿中的工作表中的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]);
}
注意事项:
- 您必须添加对Microsoft.Vbe.Interop的引用才能执行此操作。
- 我正在向目标工作簿添加一个新的通用模块,所以我不需要调用
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把一个工作簿中的工作表内容复制到另一个汇总工作簿里面的指定的工作表里面去?
如何将文件夹中的多个源工作簿中的数据复制到另一个工作簿,然后另存为新工作簿
Excel VBA - 循环遍历多个文件夹中的文件,复制范围,粘贴到此工作簿中