Question

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

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

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

Answer 1

你提到的要求以前我也遇到过，研究过这样的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
谢谢