Hi ,
Have achieved this partial but im not able to add line chart to slide 2 .i
have tried but do not got exact reason why its not added below is my script pls guide me..
sub ppt
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True ' Create a presentation
Set PPPres = PPApp.Presentations.Add
''Sheet SH01
set s=ActiveDocument.Sheets("SH01")
''Sheet SH02
set s_new=ActiveDocument.Sheets("SH02")
''GetGraphs from SH01
charts2=s.GetGraphs
''GetStraightTableBoxes from SH01
charts=s.GetStraightTableBoxes
''GetGraphs from SH02
charts2_new=s_new.GetGraphs
''Adding ppt slide
Set PPSlide = PPPres.Slides.Add(1, 1)
Set PPSlide2 = PPPres.Slides.Add(2, 1)
PPSlide.Shapes(1).Delete ' removes the title
PPSlide.Shapes(1).Delete ' removes the text box
PPSlide2.Shapes(1).Delete ' removes the title
PPSlide2.Shapes(1).Delete ' removes the text box
'vPosition=50
'' Bar Graphs
for j=lbound(charts2) to ubound(charts2)
ActiveDocument.GetSheetObject(charts2(j).getobjectid).CopyBitmapToClipboard
MsgBox( ActiveDocument.GetSheetObject(charts2(j).getobjectid).CopyBitmapToClipboard )
'PPSlide.Shapes.Paste.Select
with PPSlide.Shapes.Paste
.Left = 0
.Top = 50
.Width=400
end with
next
for i=lbound(charts) to ubound(charts)
ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard
PPSlide.Shapes.Paste.Select
next
'**********-----------Here im adding SH02 line Chart to ppt but its aadding stright table into ppt-------
Set PPSlide = Nothing
for k=lbound(charts2_new) to ubound(charts2_new)
ActiveDocument.GetSheetObject(charts2_new(k).getobjectid).CopyBitmapToClipboard
'PPSlide.Shapes.Paste.Select
with PPSlide2.Shapes.Paste
.Left = 0
.Top = 50
.Width=400
end with
next
'***************----------------------
PPPres.SaveAs "C:\temp\MyPresentation11.ppt"
PPPres.Close
PPApp.Quit
Set PPSlide2 = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
end sub
'-------------------------------------------------------------
Thanks
