使用 VBA 将 Excel 中的范围粘贴到 Powerpoint 模板的特定幻灯片中

Question

I've spent a good few hours looking at various suggested solutions to my problem but cannot find anything that seems to do the job, or more likely, my grasp of VBA is understanding my ability to make sense of the online solutions. As such, I'm hoping one of you kind folk can help me resolve things.

I have an Excel Worksheet open that contains a small amount of data (Headings and numbers etc.)

I want to copy this range and paste it (not as a picture, I want to be able to format it within powerpoint if necessary) on a particular slide (slide 2) in a Powerpoint template I have already created.

My VBA correctly opens up a new presentation based on the template using the following code:

    'Opens a PowerPoint Document from Excel

Dim objPPT As Object

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

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

objPPT.Presentations.Open "C:\Users\Colin\Dropbox (Edge45)\Edge45 Team Folder\Edge45 Company Documents\Templates\Powerpoint Templates\Edge45 Audit Template Macro.potm", Untitled:=msoTrue

However, this is where I get stuck - I don't know how to paste the Excel tabular data into the correct slide once the presentation is open. My data is in range A1:D16

Thank you so much in advance

Answer 1

Try out this one. I have assigned Excel worksheet to one variable ( XLws ) and PowerPoint slide to another ( PPslide ). You can Copy/Paste objects between them.

Btw, you need to have PowerPoint Library enabled. If you don't, in your VBA project go to Tools -> References -> Microsoft PowerPoint 15.0 Object Library .

Sub PPcopy()
Dim PPapp As PowerPoint.Application, PPpres As PowerPoint.Presentation, PPslide As PowerPoint.Slide
Dim XLws As Worksheet

    Set XLws = ActiveSheet
    Set PPapp = New PowerPoint.Application
    Set PPpres = PPapp.Presentations.Open("C:\Users\Colin\Dropbox (Edge45)\Edge45 Team Folder\Edge45 Company Documents\Templates\Powerpoint Templates\Edge45 Audit Template Macro.potm")
    PPapp.Visible = True
    Set PPslide = PPpres.Slides(2)
    XLws.Range("A1:D16").Copy
    PPslide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
    Application.CutCopyMode = False

End Sub