通过VBA将Excel表格复制到PowerPoint并保存

我正在尝试批量生成一系列PowerPoint演示文稿。我的幻灯片将包含两个元素，都是从Excel创建和复制的。我正在使用Office 2010

第一个元素是SmartArt图形，它可以顺利完成。第二个是一些单元格，我想将其复制为表对象（而不是链接图像）。在“形状”上浪费了几个小时后，我发现了这个，但粘贴后我无法操纵它的高度和宽度

PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")

然后，当我尝试使用以下命令保存演示文稿时，我意识到只有SmartArt被保存；即使saveAs命令出现在粘贴之后，粘贴的表也不会保存

PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
PPPres.SaveAs saveName, ppSaveAsDefault
PPPres.Close

更奇怪的是，我发现当我在上面的粘贴和保存之间添加了一个msgbox命令用于调试时，表被正确保存了。但是，我正在尝试批量生产这些文件，无法坐下来关闭每个消息框

我的问题是: 1.粘贴后如何更改表格的高度/宽度/对齐方式？ 2.如何保存包含表的文件

已编辑，我的当前代码

Sub copyAllToPpt()

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPName, xlName As String

xlName = ActiveWorkbook.Name
Dim saveName As String

Workbooks(xlName).Activate
Dim y As Integer
y = ActiveCell.Row
saveName = ActiveSheet.Cells(y, "B").Value & "-" & ActiveSheet.Cells(y, "A").Value & " Stats"

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Add
PPName = PPPres.Name

PPApp.ActiveWindow.ViewType = ppViewSlide

Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)

createSmartArtGraphicThenCopy

PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Height = 288
PPApp.ActiveWindow.Selection.ShapeRange.Width = 641
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
PPApp.ActiveWindow.Selection.Unselect
'Macro is working as expected up to here

Workbooks(xlName).Activate

createTable
'Table is copied in subroutine

PPApp.Activate

PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
'Application.Wait (Now + TimeValue("0:00:05"))
'Tried the Wait() to no avail.

DoEvents: DoEvents: DoEvents

PPApp.ActivePresentation.SaveAs saveName, ppSaveAsDefault
PPApp.ActivePresentation.Close

End Sub

---

当我在PPT中运行它时，它就起作用了；您需要通过向PPT应用程序对象添加引用等方式对其进行调整：

Dim oSh As Object
Dim oSl As Object
Dim x As Long

x = 1 ' or whatever slide you want to work with

Set oSl = ActivePresentation.Slides(x)

CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents: DoEvents: DoEvents

Set oSh = oSl.Shapes(oSl.Shapes.Count)

oSh.Left = 0
' etc

---

如果没有DoEvents语句，它将失败，与save问题失败的方式完全相同。除非给PPT几个周期来处理新粘贴的形状，否则它会认为它不在那里。

谢谢，但我在“设置oSh”行上看到了“运行时错误429，ActiveX组件无法创建对象”。粘贴没有发生。请告诉我好吗？另外，MetafilePicture不只是粘贴为图像吗？如何将其粘贴为可编辑表？再次感谢。您需要使用PPApp为PowerPoint添加任何命令，就像您之前发布的部分代码一样，如果使用早期绑定，则需要将oSh设置为PowerPoint.Shape或类似内容。我会把它调暗作为测试对象。谢谢。这似乎减轻了一些错误。然而，现在我得到的“对象的方法‘SaveAs’失败了”。另外，是否可以粘贴为表格而不是图片？后者是我在“MetafilePicture”中得到的。同样，请参见编辑后的答案。这给了我一张桌子。正如@steverindsberg所说的，我认为你的问题可能是时间。在粘贴表格之后、保存和关闭之前，找到暂停片刻的方法。这是你的msgbox正在做或Steves正在做的事情。谢谢。我试着按照建议使用3个“DoEvents”。系统似乎随机给出了sans表中保存的文件，或者对象_Presentation的方法“SaveAs”失败。错误。进一步更新：我对这两个元素重新排序，以便首先粘贴表，以解决时间问题。结果表明，当SmartArt平滑粘贴时，表仍然没有粘贴。看着PPT窗口，我注意到在右键单击菜单闪烁之前有一个很长的停顿。VBA保存并关闭文件后，仍存在sans表。