简体   繁体   中英

How to loop through slides in a presentation, pasting a new Excel range into a table in each slide

I am attempting to paste every 20 rows from a large range in excel into powerpoint, every 20 rows in a separate table in a separate slide, using vba. I've been struggling with this for a while so any help would be greatly appreciated.

I have already tried to loop through the excel range, which I believe works, but I have not managed to paste the ranges into separate slides - currently they paste into the same table in the same slide multiple times.

code number 1:

Loops through the excel range, but pastes into one specific table in one slide, rather than pastes each 20 rows into a separate table in separate slides:

Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object

Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")

powerpointapp.Visible = True
powerpointapp.Activate

If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0

'Make the presentation the active presentation
mypresentation.Windows(1).Activate

'copy range in excel to paste into table on powerpoint

 Dim z As Integer
 'here define the range to paste
  For z = 1 To 150 Step 20
  Range(r(z, 1), r(z + 19, 2)).Copy

' find the table on a specific slide
    With powerpointapp.ActivePresentation.Slides(3).Shapes(2).Table
    .Cell(1, 1).Select
    'paste into the table
    powerpointapp.CommandBars.ExecuteMso ("Paste")

    End With
Next z
End Sub

Code number 2:

Here I am trying to loop through slides in the presentation, but I am failing and get the error code: Shape (unknown member) invalid request. To select a shape, its view must be active

Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object

Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")

powerpointapp.Visible = True
powerpointapp.Activate

If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

   'Handle if the PowerPoint Application is not found
    If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, aborting."
    Exit Sub
    End If
    On Error GoTo 0

'Make the presentation the active presentation
mypresentation.Windows(1).Activate

'copy range in excel to paste into table on powerpoint
 Dim i As Integer
 Dim z As Integer

 'here define the range
For z = 1 To 150 Step 20
    Range(r(z, 1), r(z + 19, 2)).Copy

    'here loop through the slidse in the presentation, pasting into each slide
    For i = 3 To powerpointapp.ActivePresentation.Slides.Count
        With powerpointapp.ActivePresentation.Slides(i).Shapes(2).Table
        'Paste the range into the table
        .Cell(1, 1).Select
        powerpointapp.CommandBars.ExecuteMso ("Paste")
        End With
     Next i
Next z

End Sub

As mentioned above, I expect or am trying to paste every 20 rows into a separate table in a separate slide, but both types of code I have tried don't work - 1) the first code pastes the looped through excel range into the same table in the same slide and 2) the second code has an error.

Any help would be greatly appreciated.

I find it helpful to create tags for the PowerPoint tables set the tag name to TABLENAME and the tag value to the name of the Excel table. Then you can loop for the specific tag in question and update that table, then move to the next.

I also recommend putting your Excel data into tables in Excel and then referencing those in vba.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM