找回密码
 立即注册
搜索

VBA导出模块、窗体、类模块给另一个PPT不成功

0
回复
856
查看
[复制链接]

2

主题

6

帖子

8

幻币

一流武者

Rank: 3Rank: 3

积分
215
2019-9-28 07:41:36 显示全部楼层 |阅读模式
实现功能:
将文档“VBA导出模块、窗体、类模块给另一个PPT.ppt”中的模块、窗体、类模块等导出给自动打开的文档“新建演示文稿.ppt”。
出现的问题:
1.如果“新建演示文稿.ppt”中没有模块,则导入是成功的。
2.如果“新建演示文稿.ppt”中已经有模块,这个就会变成复制“新建演示文稿.ppt”中的模块了。例如: “新建演示文稿.ppt”中已经有“模块1”,运行后多了一个“模块11”,原来的幻灯片中的模块、窗体等都没有复制过去。怎样解决这个问题?
“VBA导出模块、窗体、类模块给另一个PPT.ppt”中的代码如下:
Sub CopyVBComponents() '复制窗体、模块、类模块给另一个PPT
Dim f$, p$, d, ppt_name
Set d = CreateObject("Scripting.Dictionary")
p = ActivePresentation.Path & ""
f = Dir(p & "*.ppt")
Do While Len(f)
If f  ActivePresentation.Name Then '本文件除外
d(f) = ""
End If
f = Dir
Loop
ppt_name = d.keys '将字典的数据放入数组
If (UBound(ppt_name) < 0) Then
MsgBox "当前目录下没有其它的PPT", 48, "警告"
Exit Sub
Else
For i = 0 To UBound(ppt_name)
Set pptInput = Presentations.Open(p & "" & ppt_name(i), ReadOnly:=msoFalse)
'================= 以下是复制窗体、模块、类模块
Dim vbc As Object
Application.VBE.MainWindow.SetFocus
For Each vbc In Application.VBE.ActiveVBProject.VBComponents
vbc.Export p & "" & vbc.Name '导出
pptInput.VBProject.VBComponents.Import p & "" & vbc.Name '导入
Kill p & "" & vbc.Name '删除导出
Next
Presentations(p & "" & ppt_name(i)).Save
Presentations(p & "" & ppt_name(i)).Close
Next i
End If
End Sub
VBA导出模块、窗体、类模块给另一个PPT.rar (75.17 KB, 下载次数: 138)
PPT学习论坛
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册