如何运用VBA复制模块到新工作薄（两种方法）

作者：绿色风分类：时间：2022-08-18 浏览：150

楼主
xmyjk

Q:如何用VBA
复制工作薄中的指定模块的代码（如：自定义函数）到新建的工作薄中？

A：需引用 MICROSOFT VISUAL BASIC FOR APPLICATION EXTENSIBILITY 5.3
还需信任对VBA工程对象的模型的访问。

第一种方法：导出指定模块，然后新建工作薄，导入之前导出的模块：

Sub copymodule()
Dim sfname As String, wb As Workbook
sfname = Environ("temp") & "\" & "myfun" & ".bas" '将系统临时目录作为保存模块的目录
If Len(Dir(sfname)) > 0 Then Kill sfname '如果相同的模块文件存在，就干掉
ThisWorkbook.VBProject.VBComponents("myfun").Export sfname '导入模块
Set wb = Workbooks.Add '新建工作薄
wb.VBProject.VBComponents.Import sfname '导入模块
Kill sfname '干掉导出文件
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Int(Rnd() * 10) & ".xls", FileFormat:=xlExcel8 '保存新建工作薄
wb.Close '关闭
End Sub

第二种：找到指定的模块，将模块的代码保存到中间变量S中，然后新建工作薄，新建模块，将变量S写入：

Sub addfuntonewwb()
Dim smodulename As String
Dim ovbproj As VBIDE.VBProject
Dim ovbcomp As VBIDE.VBComponent
Dim ocodemod As VBIDE.CodeModule
Dim lLinestart As Long
Dim wb As Workbook, sfunc As String, lindex As Long
With ThisWorkbook.VBProject.VBComponents("myfun").CodeModule '找到xmfun模块的代码区域
For lindex = 1 To .CountOfLines '从第一行历遍到最后一行
sfunc = sfunc & .Lines(lindex, 1) & Chr(10) '把每行的代码语句连接并用换行符间隔并赋予SFUNC文本变量
Next
End With
Set wb = Workbooks.Add '新建工作薄
Set ovbproj = wb.VBProject
Set ovbcomp = ovbproj.VBComponents.Add(vbext_ct_StdModule) '新建模块
ovbcomp.Name = "自定义函数" '命名为“自定义函数”
Set ocodemod = ovbcomp.CodeModule
With ocodemod 对模块的代码框区域进行相关写入工作
lLinestart = .CountOfLines + 1 '从已有区域的下一行写入
.InsertLines lLinestart, sfunc '插入原本导出的代码文本
End With
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Int(Rnd() * 10) & ".xls", FileFormat:=xlExcel8 '另存工作薄
wb.Close '关闭工作薄
End Sub

拷贝自定义函数.rar

2楼
scamboby

这个复制好象只能复制自定义的函数和模块，如果想复制针对工作薄的事件响应代码到新建的工作薄中，该怎么做呢

3楼
icenotcool

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表