Macro to export sheet on one slide.

[mishraamit2485]

Hi All,

I have one requirement where I have to export the sheet objects to PPT, i do have macro for that but here is the tricky part.

I have three Regions(AMS APJ EMEA) and two Years 2013 2014 with these buttons my data filter in my pivot, so when a user clicks on export to ppt button first macro will filter the data for AMS 2013 than AMS 2014 and print on ppt(Both AMS Years 2013 & 2014 on other slides with heading AMS 2013/2014) once done APJ 2013, APJ 2014 on new slides of same ppt(Both APJ Years on Same slide with heading APJ 2013/2014), after that EMEA 2013, 2014 on new slide, all the three action will happen in just one click.

I want to see my AMS pivot for 2013 on one slide1 and AMS 2014 one next slide2, APJ pivot 2013 on one slide3 and APJ 2014 on slide4 so on in...with one click.

Please help

Attaching the sample QVW.

[marcus_sommer]

I think this will be helpful: Automated PowerPoint Presentation Extraction.

- Marcus

[ecolomer]

See this example

[mishraamit2485]

@ Enrique,

What this macro is doing its always opens a new PPT, i want to add in the existing PPT with new slide.(New Sheet object all objects on that sheet) should go to new slide

[ecolomer]

try this

and you need to personalize the names

[mishraamit2485]

Nopes still other ppt is opening

I'm giving you the example suppose I have selected 2003 and then click export it should open the ppt and slide 1 not i cleared my selection and again selected 2004 now it should write on the existing ppt but on the new slide let say slide 2..

so slide 1 will have data for 2003 and slide 2 will have data for 2004.

[mishraamit2485]

Hi Enrique,

I got one solution which is working well, here is the code.

The problem with this is it is adding slide in ascending order,Like my first PPT export creates 1st slide and my 2nd export adds another slide to my ppt, but my 1st slide is moving to the next slide place, 2nd is becoming 1st slide and 1st is becoming 2nd slide and so onm we want other way.

Any suggestions?

sub PPT_Export_with_Template

  ActiveDocument.ActiveSheet.ApplyZoomToAllSheets

  Set PPApp = CreateObject("PowerPoint.Application")

  PPSlideNo =2

  PPApp.Visible = True

  'Set PPres = PPApp.Presentations.Add

  If (not PPTFileIsOpen(PPApp,"C:\t\Template.pptx")) Then

  Set PPres = PPApp.Presentations.Open("C:\t\Template.pptx")

  else

    SET PPres = ppApp.Presentations("C:\t\Template.pptx")

  end if

  'Apply a template if you want one

  'PPres.ApplyTemplate("C:\t\Template.potx")

  'For i = 0 to ActiveDocument.NoOfSheets - 1

  Set PPSlide = PPres.Slides.Add(PPSlideNo,1)

  ActiveDocument.GetApplication.WaitForIdle

  ActiveDocument.ActiveSheet.CopyBitmapToClipboard

  PPSlide.Shapes.PasteSpecial(3)

  with PPSlide.Shapes(PPSlide.Shapes.Count)

  .left = 1

  .top = 1

  .width =715

  end with

  activedocument.nexttab

  PPSlideNo = PPSlideNo + 1

' NEXT

  Set PPSlide = Nothing

  Set PPPres = Nothing

  Set PPApp = Nothing

  msgbox ("PPT Export is done Successfully!")

ActiveDocument.Variables("vShowAll").SetContent "1", true      

End Sub

Function PPTFileIsOpen(pptApp,sFullname)

  Dim x

  For x = 1 to pptApp.Presentations.Count

    if (pptApp.Presentations(x).fullname = sFullname )  Then

      PPTFileIsOpen= True

      Exit Function

    end if

  Next

End Function