通过VBA将Excel表格复制到PowerPoint并保存
我正在尝试大量生成一系列PowerPoint演示文稿。 我的幻灯片将包含两个元素，都创build和从Excel复制。 我正在使用Office 2010。
第一个元素是一个顺利完成的SmartArtgraphics。 第二个是我想复制为Table对象 （而不是链接的图像）的几个单元格。 在“形状”浪费了几个小时之后，我发现了这一点，但粘贴之后我无法操纵它的高度和宽度 。
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting") 然后，当我尝试使用以下内容保存演示文稿时，我意识到只有SmartArt被保存; 即使在粘贴之后发生saveAs命令，粘贴的表格也不会被保存。
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting") PPPres.SaveAs saveName, ppSaveAsDefault PPPres.Close
更奇怪的是，我发现当我添加一个msgbox命令进行debugging时，在上面的粘贴和保存之间，表格被正确保存。 但是，我试图批量生产这些文件，不能坐下来closures每个消息框。
我的问题：1.粘贴后如何更改桌子的高度/宽度/alignment方式？ 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语句，它就会失败，就像保存问题失败一样。 除非你给PPT几个周期来处理新粘贴的形状，否则它认为它不在那里。