PPT

[srinivasa1]

Hi.

Finally i have created ppt useing macro  but  all charts comes in diifrent slide, i need two particaluer silde only..like mainsheet  in one slide sheet1 in slide 2

pls can any guide me where im worng.and  find attached test application...

[#2 · Accepted solution]

you need to move

Set PPSlide = PPPres.Slides.Add(1, 1)

           PPSlide.Shapes(1).Delete ' removes the title

           PPSlide.Shapes(1).Delete ' removes the text box

before your loop

whole script should be like:

sub ppt1

Set PPApp = CreateObject("Powerpoint.Application")

MsgBox("Hello")

PPApp.Visible = True ' Create a presentation

Set PPPres = PPApp.Presentations.Add

'''''''''' For All Sheets '''''''''

for j = 0 to ActiveDocument.NoOfSheets - 1

          ActiveDocument.Sheets(j).Activate

          set ss= ActiveDocument.GetSheet(j)

    shID =ucase(mid(ss.GetProperties.SheetID,10))

          shName=ss.GetProperties.Name

          ActiveDocument.GetApplication.WaitForIdle

          'ActiveDocument.GetApplication.Sleep 5000

          'msgbox shName & "--" & shID

''''''''''''''''''''''''''''''''''''''''''

           ActiveDocument.Sheets(shName).Activate

          ActiveDocument.Sheets(j).Activate

          set s=ActiveDocument.ActiveSheet

          charts=s.GetSheetObjects

          Set PPSlide = PPPres.Slides.Add(1, 1)

           PPSlide.Shapes(1).Delete ' removes the title

           PPSlide.Shapes(1).Delete ' removes the text box

                     for i=lbound(charts) to ubound(charts)

                                if(UCASE(mid(charts(i).getobjectid,10,2)))="CH" then

                                          ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard

                                          PPSlide.Shapes.Paste

                                         'ActiveDocument.GetApplication.Sleep 1000

                               end if

           next

next ''for sheets next move

PPPres.SaveAs "C:\temp\MyPresentationPPT.ppt"

PPPres.Close

PPApp.Quit

Set PPSlide = Nothing

Set PPPres = Nothing

Set PPApp = Nothing

end sub

sub sheets

MsgBox("Hello")

for i = 0 to ActiveDocument.NoOfSheets - 1

    set ss= ActiveDocument.GetSheet(i)

    msgbox(ss.GetProperties.Name)

next

end sub

'sub Trends

'Set PPApp = CreateObject("Powerpoint.Application") 

'PPApp.Visible = True ' Create a presentation  

'Set PPPres = PPApp.Presentations.Add

'set s=ActiveDocument.Sheets("Trends") 

'charts2=s.GetGraphs  

''charts3=s.GetPivotTableBoxes

'charts=s.GetStraightTableBoxes

'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)    

'ActiveDocument.GetSheetObject(charts(i).getobjectid).CopyBitmapToClipboard      

'PPSlide.Shapes.Paste.Select        

'next

'

'for j=lbound(charts2) to ubound(charts2)    

'ActiveDocument.GetSheetObject(charts2(j).getobjectid).CopyBitmapToClipboard      

'PPSlide.Shapes.Paste.Select        

'next

'

'for k=lbound(charts3) to ubound(charts3)    

'ActiveDocument.GetSheetObject(charts3(k).getobjectid).CopyBitmapToClipboard      

'PPSlide.Shapes.Paste.Select        

'next

'

'PPPres.SaveAs "C:\Temp\MyPresentation.ppt" 

'PPPres.Close  

'PPApp.Quit  

'Set PPSlide = Nothing  

'Set PPPres = Nothing  

'Set PPApp = Nothing

[srinivasa1]

Hey Thanks its working.you have saved my time..i thought about it, but i got confuse after debugging lot.

Thanks again

[srinivasa1]

Hi Pari,

Just clear me on think in this why sheet 2 added in slide1..its not add in Sequence?

Thanks