100分求解!求VBA代码,在EXCEL里用VBA自动将EXCEL数据复制到PPT中

大家好,本人要将EXCEL中每个表的内容都放到PPT中,因为有上百个工作表,如果手动一个一个地复制去PPT中(一个EXCEL表占一页PPT),很费时。
求VBA代码,具体要求:执行代码后,自动打开PPT程序,并自动新建PPT页面,然后将上百个EXCEL工作表逐页地复制到PPT中。我只要简单地将EXCEL表复制去PPT即可,不需要实现其他特殊效果。

另,
A. 本人用的是Office2013,从2007开始,PPT就没有录制宏的功能,不要跟我说录制宏。但你们可以录制一个宏,复制上来让我参考参考。
B. 代码最好加上注释。

你提到的要求以前我也遇到过,研究过这样的VBA代码。
但最终没有完全实现,因为Excel的sheet页面区域很大,而ppt的单页很有限,即使按照sheet的打印页对应ppt的单页也难实现。excel的页面布局也很难复制到ppt中保证不变形。
但我找到了另外一个方法,可以每个sheet变成一张图片对应ppt中的每一个页。这样VBA可以实现,但是缺点是在PPT中的内容是图片,文字等内容不可编辑,并且sheet页面很大时ppt的图片显示相当内容很小。
不知道导出图片放到PPT中这样的实现方案能否满足你的要求,如果可以的话,我可以提供VBA代码帮助。追问

我的Sheet页面内容很小,可以肯定不会变形。因为手动一张一张复制过去,完全不变形,也不需要任何调整。既然手动复制不变形,我就想用VBA实现。
你把图片自动复制过去PPT,这个VBA过程正是我想要的。烦请提供。

追答

有点抱歉啊!我写的那段代码找不到了,临时编写了一段,但是图片向PPT粘贴的时候老是出现错误,今天工作有点忙,我先把代码丢给你吧,你先研究研究,我有空再帮你修改一下。
Dim ptApp As Object
Set ptApp = CreateObject("PowerPoint.Application")
Dim ptPre As Object
Set ptPre = ptApp.Presentations.Add
Dim ptSld As Object
ptApp.Visible = msoTrue

For i = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(i).Range("A1:" & Split(Columns(ActiveWorkbook.Sheets(i).UsedRange.Columns.Count).Address(False, False), ":")(0) & ActiveWorkbook.Sheets(i).UsedRange.Rows.Count).CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set ptSld = ptPre.Slides.Add(Index:=ptPre.Slides.Count + 1, Layout:=ppLayoutBlank)

'ActiveWindow.View.Paste '就是获取到图片后粘贴时老是出错
Next i

追问

你好,谢谢你的回复。
我运行的时候,
Set ptSld = ptPre.Slides.Add(Index:=ptPre.Slides.Count + 1, Layout:=ppLayoutBlank)

运行到 PPLayoutBlank 这里总是“提示未定义的变量”。
之前我也试了N次了。自己编了一个程序,也是提示这个错误。
我是否可以加你QQ?我QQ是:591490775
谢谢

温馨提示:答案为网友推荐,仅供参考
相似回答