Copy & Pasting multiple Excel Ranges to Seperate Powerpoint Slides with VBA

LauraBlair

New Member
Joined
Feb 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I am hoping i can get some assistance with this code. I have found the below code from The Spreadsheet Guru to copy ranges from 2 separate sheets in Excel and paste them into separate slides in PowerPoint, but i cannot get the *Paste to PowerPoint and Position Working, i have edited the slides required and the ranges. This error is displayed when run "Slides item: Integer out of range. 2 is not in index's valid range of 1 to 1".

Thank you in advance.

VBA Code:
Sub PasteMultipleSlides()
'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long

'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then Exit
      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 PowerPoint Visible and Active
  PowerPointApp.ActiveWindow.Panes(2).Activate
    
'Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation

'List of PPT Slides to Paste to
  MySlideArray = Array(2, 3)

'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet1.Range("A1:BN24"), Sheet1.Range("A1:F17"))

'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    'Copy Excel Range
        MyRangeArray(x).Copy
    
    'Paste to PowerPoint and position (This is what i cant get to work)
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0
    
    'Center Object
      With myPresentation.PageSetup
        shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
        shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
      End With
      
  Next x

'Transfer Complete
  Application.CutCopyMode = False
  ThisWorkbook.Activate
  MsgBox "Complete!"
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,726
The error means that the active presentation does not contain a second slide. And, by extension, doesn't contain a third one either.
 

LauraBlair

New Member
Joined
Feb 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
The error means that the active presentation does not contain a second slide. And, by extension, doesn't contain a third one either.
Thanks Domenic. Could you please point me in the right direction as to how to add additional slides to the active presentation in my code? Sorry, still trying to learn the ropes of VBA. Thank you
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,726
To add a new slide and then paste to it, try replacing...

VBA Code:
    'Paste to PowerPoint and position (This is what i cant get to work)
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0

with

VBA Code:
        'Add a new slide
        Set mySlide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 32) 'ppLayoutCustom
       
        'Paste object
        Set shp = mySlide.Shapes.PasteSpecial(DataType:=2)

For other types of slide layouts, have a look here...


Hope this helps!
 
Last edited:

LauraBlair

New Member
Joined
Feb 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

To add a new slide and then paste to it, try replacing...

VBA Code:
    'Paste to PowerPoint and position (This is what i cant get to work)
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0

with

VBA Code:
        'Add a new slide
        Set mySlide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 32) 'ppLayoutCustom
      
        'Paste object
        Set shp = mySlide.Shapes.PasteSpecial(DataType:=2)

For other types of slide layouts, have a look here...


Hope this helps!
Thank you Domenic, works great.

Just a question which you can probably help me with, this code you need to have PowerPoint open to run, and when you open PowerPoint up, a title page is there. When the macro runs, it adds 2 slides after the title page, can the macro either delete the title page within the macro, or use the title page with the first paste, and then add 1 slide for the second paste so only 2 slides all up?

Thank you again, you are a life saver.
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,726
To delete the first slide from your presentation, simply add the following line after your For/Next loop, which adds your two slides...

VBA Code:
    myPresentation.Slides(1).Delete
 

LauraBlair

New Member
Joined
Feb 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
To delete the first slide from your presentation, simply add the following line after your For/Next loop, which adds your two slides...

VBA Code:
    myPresentation.Slides(1).Delete
Thanks so much Domenic
 

Forum statistics

Threads
1,141,773
Messages
5,708,453
Members
421,570
Latest member
BaileyJ

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top