Copying the Data from Excel to PowerPoint table using VBA

Question

Let me explain you what I'm trying to do, then I'll explain you where I'm stuck

--> Copy data from Excel table to PowerPoint table (they both have same header), for each row containing data

--> If table in PowerPoint crosses the certain height it should start pasting data on new slide

So, this how I'm approaching:

--> First, considering one slide in ppt as master slide, where table has headers and one blank row below it - I'll copy this slide and paste it when I'll move to next slide

--> copy one row each from Excel and paste it in PowerPoint table

--> if the table in PowerPoint cross the certain height, then paste the new master slide (which I have in copy)

--> this loop should continue for each row in Excel which has data.

I'm approaching to it bit by bit; so far I have created the loop for inserting the row in .ppt table and pasting the slide if it crosses the table height limit. But I'm stuck here - the loop given below insert rows only for master slide and paste the next slide but doesn't insert in other slides.

Public Sub Excel_cpy_pst()

Dim oTbl As Table
Dim mShp As ShapeRange
Dim shp As Object
Dim sldCount As Slide

Set sldCount = ActivePresentation.Slides(ActivePresentation.Slides.Count)

ActivePresentation.Slides(6).Copy 'Copying and using it as a master slide

Set mShp = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("MyShape"))
Set oTbl = mShp.Table

For Each shp In ActivePresentation.Slides
    If mShp.Height <= 6.34 * 72 Then
    With oTbl
        .Rows.Add (-1) 'adding  a row at the bottom of a table
    End With
    ElseIf ActivePresentation.Slides.Count <= 8 Then 'to stop it from infinite loop, putting a constatnt
        With ActivePresentation.Slides
            ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
        End With
    End If
Next

End Sub

rgo rgo · Accepted Answer · 2015-04-07T23:59:37

If you start by duplicating your masterslide you can assign the new slide to a variable that can be referenced.

Dim aSLide as Powerpoint.SlideRange

Set aSlide = .Slides("Slide1").Duplicate

with aSlide
  for each shp in aslide.shapes

Add this to your loop to reference the new copy of the original slide.

If your slide template (slide1) is constructed as a table, you can assign the text to each cell in the table then move to the next slide without checking the size. Just fill in the boxes as you go.

Good luck!

Copying the Data from Excel to PowerPoint table using VBA

1 Answers