I am trying to mass-generate a series of PowerPoint presentations. My slide would contain two elements, both created and copied from Excel. I am using Office 2010.
The first element is a SmartArt graphic which is smoothly done. The second one is a few cells that I would like to copy as a Table object (instead of a linked image). After wasting a few hours with “Shapes”, I found this, but I cannot manipulate its height and width after pasting.
Then, when I tried to save the presentation using the following, I realised only the SmartArt is saved; the pasted table is not saved even though the saveAs command occured after the paste.
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting") PPPres.SaveAs saveName, ppSaveAsDefault PPPres.Close
More bizarrely, I found that when I added a msgbox command for debugging above between paste and save, the table is saved correctly. However, I am trying to mass produce these files and cannot sit down to close each message box.
1. How can I change the table’s height/width/alignment after pasting?
2. How can I save my file with the table in it?
EDITED, my current code
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
This works when I run it from within PPT; you’ll need to adapt it by adding references to the PPT application object, etc:
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
Without the DoEvents statements, it fails, in exactly the same way as your save problem fails. Unless you give PPT a few cycles to deal with the newly pasted shape, it thinks that it’s not there.