Copying Table from Excel into Powerpoint using a p

Question

I have written the below code to copy and paste two tables over two pages into Powerpoint as an image, what I would like to do however is if I have a table template already set up in Powerpoint with one blank row, copy the table rows from Excel into Powerpoint and if it goes over say 20 rows in Powerpoint start a new page with the same template.

I have looked through lots of codes but nothing seems to be dynamic for what I am after in terms of copying to a pre set template. Thanks in advance

Sub CopytoPowerpoint

Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Set PPApp = CreateObject("Powerpoint.Application")
Dim SlideNum As Integer

Set Xlapp = GetObject(, "Excel.Application")

'input Powerpoint template
Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
'path of the Powerpoint template
strPresPath = "C:\Documents and settings\Desktop\Product\ProductTemplate.pptx"
'save the new Presentation to be created
    strNewPresPath = "C:\Documents and Settings\Desktop\Product\ Monthly Reporting Pack-" & Format(Date, "dd-mmm-yyyy") & ".pptx"
    PPApp.Visible = True
    Set PPPres = PPApp.Presentations.Open(strPresPath)
    PPPres.Application.Activate

''define destination slide
    SlideNum = 2
    PPPres.Slides(SlideNum).Select
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

''define source sheet
    Sheets("Sheet1").Activate

'copy/paste from
    Xlapp.Range("Table1").Copy 
    PPSlide.Select
    With PPSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
            .Item(1).ScaleHeight 0.75, msoCTrue, msoScaleFromMiddle
            .Item(1).ScaleWidth 0.62, msoCTrue, msoScaleFromMiddle
            .Item(1).Left = 10
            .Item(1).Top = 120

    End With

''define destination slide
    SlideNum = 3
    PPPres.Slides(SlideNum).Select
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

''define source sheet
    Sheets("Sheet1").Activate
'copy/paste from
    Xlapp.Range("Table2").Copy
    With PPSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
            .Item(1).ScaleHeight 0.75, msoCTrue, msoScaleFromMiddle
            .Item(1).ScaleWidth 0.62, msoCTrue, msoScaleFromMiddle
            .Item(1).Left = 10
            .Item(1).Top = 120

   End With
' Close presentation
    PPPres.SaveAs strNewPresPath
    'PPPres.Close
    'Quit PowerPoint
    'PPApp.Quit


Xlapp.Visible = True
Application.CutCopyMode = False
MsgBox "Presentation Created", vbOKOnly + vbInformation

' Clean up

Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub

Answer 1

Using the ExecuteMso method (not well documented, but it comes in very handy for pasting data between applications, etc.), you should be able to do this:

Here is the Excel table:

And here is the output to PowerPoint:

This assumes that the table in PPT is sized with the correct number of columns. If it is not, you may need additional logic to add/remove columns conditionally. This does not preserve any formatting from Excel, so it is relying on the table Style as specified in the PowerPoint table/template.

Sub copyTableRowsToPPT()
    Dim tbl As ListObject
    Dim tblRows As Range
    Dim r As Long 'row counter
    Dim c As Long 'col counter
    Dim ppt As Object 'PowerPoint.Application
    Dim ppPres As Object 'PowerPoint.Presentation
    Dim ppSlide As Object 'PowerPoint.Slide
    Dim ppShape As PowerPoint.Shape 'PowerPoint.Shape
    Dim ppTable As PowerPoint.Table 'PowerPoint.Table
    'Handle the Table in Excel
    Set tbl = ActiveSheet.ListObjects("Table1")            ' Rename based on your table name
    'Get the ROWS from the Table in Excel
    Set tblRows = tbl.DataBodyRange.Rows


    'Get PowerPoint objects...
    Set ppt = GetObject(, "PowerPoint.Application")
    Set ppPres = ppt.presentations(1)
    Set ppSlide = ppPres.Slides(1)
    Set ppShape = ppSlide.Shapes("Content Placeholder 5")  ' Rename based on your Shape name
    Set ppTable = ppShape.Table

    ' Copy the rows (but not headers) from Excel
    tbl.DataBodyRange.Copy

    ppTable.Rows.Add.Cells(1).Select
    ' Paste in to PowerPoint, keeping the PowerPoint theme/formatting
    ppt.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle")

End Sub

If you would prefer to use the Excel style, that can also be done using "PasteExcelTableSourceFormatting". As you may have gathered, you could just use this method to copy/paste the entire table in to PowerPoint, rather than trying to insert to an existing "template" table.

I believe this could be modified to "split" the table over additional slides in PowerPoint, if needed. If you're stuck on that implementation, let me know and I can update the answer with more detail.