MAcro to paste excel table into PPT slide automatically

[sameeru]

Hello GUys,

Need help on macro. I am attaching sample file.
I want the data and table in the excel sheet to be pasted in PPT slide automatically.

[mikeTRON]

So powerpoint macros are not as easy to find compared to excel.

http://peltiertech.com/Excel/XL_PPT.html

[sameeru]

Thanks for the link.

But I am very New to Macro. so can you please write the code in my attached sheet and send me the updated sheet that will be very helpfull for me thanks a lot

Regards
Sam

[geliedee]

Hi sameru,

See this file. Hope it could help you.

i divided it to 3 slides because having them in one slide is kinda crowded.

[geliedee]

Enable content first, then click the buttons one by one.
They will all go to one power point slides. :D

[sameeru]

Thanks A lot its really help full.
How can i view the code and if it is poosible to make it in one cilck. As I want the whole table in one slide

Regards
Sam

[geliedee]

Hi Sameeru,

You can click ALT + F11 to view the codes

If you wish to change the columns to be exported in PPt, you can just simply change the range. You can see it in the codes! :D

[mikeTRON]

Can you post the code in here?

[geliedee]

Anyway, if you want to view it in one slide,
it will be very small and not advisable. But you can try just change the range.

[sameeru]

Sorry Im not able to see the code its coming blank and asking some password after pressing ATL + F11

[mikeTRON]

The code is password protected.

Can you simply paste it in here anyway so I can view it on my phone?

[geliedee]

Hi MikeTron and Sameeru,

this file is unprotected.

or you can use this code.

CreatePPT - Button 1
CreatePPT2 -Button 2
CreatePPT3- Button 3

Sub CreatePPT()
    Dim PPApp As PowerPoint.Application
    Dim PPSlide As PowerPoint.Slide
    Dim SheetName As String
    Dim RangePasteType As String
    Dim shp As Shape
    Dim shps As Shapes
    Dim RangeName1, RangeName2 As String

    SheetName = ActiveSheet.Name ' Both the tables are in same worksheet
    RangeName1 = "A2:H50"
    RangeName2 = "A2:H50"
 
    If PPApp Is Nothing Then Set PPApp = New PowerPoint.Application
    If PPApp.Presentations.Count = 0 Then PPApp.Presentations.Add
    PPApp.Visible = True
 
    'Set first slide
    '//Set PPSlide = PPApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
 
    Worksheets(SheetName).Range("A2:H15").Copy
   
 
    Set PPSlide = PPApp.ActivePresentation.Slides.Add(PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank)
    Worksheets(SheetName).Range("A2:H17").Copy
   With PPSlide.Shapes.PasteSpecial(ppPasteMetafilePicture)
       .Align msoAlignCenters, True
       .Align msoAlignMiddles, True
       .Item(1).ScaleHeight 1, msoCTrue, msoScaleFromMiddle

   End With

    AppActivate ("Microsoft Powerpoint")
    'Clean up
    Set PPSlide = Nothing
    Set PPApp = Nothing
End Sub
Sub CreatePPT2()

    Dim PPApp As PowerPoint.Application
    Dim PPSlide As PowerPoint.Slide
    Dim SheetName As String
    Dim RangePasteType As String
    Dim shp As Shape
    Dim shps As Shapes
    Dim RangeName1, RangeName2 As String

    SheetName = ActiveSheet.Name ' Both the tables are in same worksheet
    RangeName1 = "A2:H50"
    RangeName2 = "A2:H50"
 
    If PPApp Is Nothing Then Set PPApp = New PowerPoint.Application
    If PPApp.Presentations.Count = 0 Then PPApp.Presentations.Add
    PPApp.Visible = True
 
    'Set first slide
    '//Set PPSlide = PPApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
 
    Worksheets(SheetName).Range("A2:H15").Copy
   
 
    Set PPSlide = PPApp.ActivePresentation.Slides.Add(PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank)
    Worksheets(SheetName).Range("A18:H32").Copy
   With PPSlide.Shapes.PasteSpecial(ppPasteMetafilePicture)
       .Align msoAlignCenters, True
       .Align msoAlignMiddles, True
       .Item(1).ScaleHeight 1, msoCTrue, msoScaleFromMiddle

   End With

    AppActivate ("Microsoft Powerpoint")
    'Clean up
    Set PPSlide = Nothing
    Set PPApp = Nothing
End Sub
Sub CreatePPT3()

    Dim PPApp As PowerPoint.Application
    Dim PPSlide As PowerPoint.Slide
    Dim SheetName As String
    Dim RangePasteType As String
    Dim shp As Shape
    Dim shps As Shapes
    Dim RangeName1, RangeName2 As String

    SheetName = ActiveSheet.Name ' Both the tables are in same worksheet
    RangeName1 = "A2:H50"
    RangeName2 = "A2:H50"
 
    If PPApp Is Nothing Then Set PPApp = New PowerPoint.Application
    If PPApp.Presentations.Count = 0 Then PPApp.Presentations.Add
    PPApp.Visible = True
 
    'Set first slide
    '//Set PPSlide = PPApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
 
    Worksheets(SheetName).Range("A2:H15").Copy
   
 
    Set PPSlide = PPApp.ActivePresentation.Slides.Add(PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank)
    Worksheets(SheetName).Range("A33:H51").Copy
   With PPSlide.Shapes.PasteSpecial(ppPasteMetafilePicture)
       .Align msoAlignCenters, True
       .Align msoAlignMiddles, True
       .Item(1).ScaleHeight 1, msoCTrue, msoScaleFromMiddle

   End With

    AppActivate ("Microsoft Powerpoint")
    'Clean up
    Set PPSlide = Nothing
    Set PPApp = Nothing
End Sub

[mikeTRON]

Hey,

So I am getting an error with the following line of code (with the bold portion):
Set PPSlide = PPApp.ActivePresentation.Slides.Add(PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank)

What am I missing?

[geliedee]

Hi MikeTron,

did you click "Microsoft powerpoint 12.0 Object Library" on the references? References - VBAProject.jpg