Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hello everyone,
Can anyone help me how to export a pivot table into PPT, I hav done couple of permutations with the macro for exporting charts & its working only for pie charts but not with pivot table.
The code follows like this:
sub sendToPPT()
Set PPApp = CreateObject("Powerpoint.Application")
fname=InputBox("Enter FileName","SaveAs","MyPresentation")
PPApp.Visible = True ' Create a presentation
Set PPPres = PPApp.Presentations.Add
set s=ActiveDocument.Sheets("Sheet2")
charts=s.GetGraphs
Set PPSlide = PPPres.Slides.Add(1, 1)
PPSlide.Shapes(1).Delete ' removes the title
PPSlide.Shapes(1).Delete ' removes the text box
vPosition=50
for i=lbound(charts) to ubound(charts)
Set PPSlide = PPPres.Slides.Add(1,1)
'PPSlide.Shapes(1).Delete ' removes the title
'PPSlide.Shapes(1).Delete ' removes the text box
msgbox(charts(i).getobjectid)
ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard
PPSlide.Shapes.Paste.Select
PPApp.ActiveWindow.Selection.ShapeRange.Left = 10
PPApp.ActiveWindow.Selection.ShapeRange.Top = vPosition
vPosition = vPosition + 10
next
PPPres.SaveAs "D:\QlikView\DATABASE\CDR\Applications"&fname&".ppt"
' PPPres.Close
PPPres.Close
PPApp.Quit
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
end sub
--
Best Regards,
Gargi
Hi Gargi,
Did you figure out a solution for this? If yes, can you share in the forum?
Thanks,
Manoj
Hi Manoj,
Try this:
sub ppt1
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True ' Create a presentation
Set PPPres = PPApp.Presentations.Add
set s=ActiveDocument.Sheets("Sheet1") /// name of your Sheet
'charts=s.GetGraphs
charts=s.GetSheetObjects
for i=lbound(charts) to ubound(charts)
if(UCASE(mid(charts(i).getobjectid,10,2)))="CH" then
Set PPSlide = PPPres.Slides.Add(1, 1)
PPSlide.Shapes(1).Delete ' removes the title
PPSlide.Shapes(1).Delete ' removes the text box
ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard
PPSlide.Shapes.Paste
end if
next
PPPres.SaveAs "C:\Temp\MyPresentationSheet1.ppt" ////// Location u want to save the PPT
PPPres.Close
PPApp.Quit
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
end sub