CODEWITHSUNDEEP
vbaexcelpowerpoint
Mark harris
Mark harris

Reputation: 543

Open PowerPoint and copy from Excel to specific slide

I am wanting to open an existing PowerPoint template and select slide 3 and copy a table from my spreadsheet to the PowerPoint slide.

Please can someone show me how to do this? 

Sub Open_PowerPoint_Presentation()
'Opens a PowerPoint Document from Excel

    Dim objPPT As Object
    Dim PPSlide As Object

    Set objPPT = CreateObject("PowerPoint.Application")
    Set PPSlide = objPPT.Slides(5)

    objPPT.Visible = True

    'Change the directory path and file name to the location
     'of your document

    objPPT.Presentations.Open "\\MI-FILESERVE1\Shared Folders\Shared_Business_Dev\assets\Tender Time Allocation Deck.pptx"

    PPSlide.Select




     End Sub

Upvotes: 1

Views: 8126

Answers (1)

R3uK
R3uK

Reputation: 14537

Be CAREFUL : You cannot paste in the Shapes of your Slide if the collection is empty

I.E. : you'll need a slide with at least a title or a shape (square, triangle, ...) to be able to paste what you have copied in your clipboard.

Here are the basics, you should correct the excel lines to copy what you want :

Sub Open_PowerPoint_Presentation()

Dim objPPT As Object, _
    PPTPrez As PowerPoint.Presentation, _
    pSlide As PowerPoint.Slide

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

Set PPTPrez = objPPT.Presentations.Open("\\MI-FILESERVE1\Shared Folders\Shared_Business_Dev\assets\Tender Time Allocation Deck.pptx")
Set pSlide = PPTPrez.Slides(5)

If pSlide.Shapes.Count <> 0 Then
    'Table
    ActiveWorkbook.Sheets("Sheet1").Range("Named Range").Copy
    pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
    'OR
    ActiveWorkbook.Sheets("Sheet1").Range("Named Range").CopyPicture
    pSlide.Shapes.Paste

    'Charts
    ActiveWorkbook.Sheets("Graph1").ActiveChart.ChartArea.Copy
    pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
    'OR
    ActiveWorkbook.Sheets("Graph1").ActiveChart.ChartArea.CopyPicture
    pSlide.Shapes.Paste
Else
    MsgBox "There is no shape in this Slide (" & pSlide.SlideIndex & ")." & vbCrLf & "Please use a slide with at least one shape, not a blank slide", vbCritical + vbOKOnly
End If

End Sub

Upvotes: 1

Related Questions