1 Reply Latest reply: Aug 4, 2017 11:28 AM by Brent Nichol RSS

    Export to PPT vba

    Sugapathi Namasivayam

      Hi ,I don't really know VB scripting ,  I have tried modified this below code. It produces what I want but not what I need in general.

       

      I need it to separate all the objects(4 charts in one slide )  in different slides in PPT. Currently it exports to only one slide and overlaps one another.

      Any help on how to separate.

      Note: Object a1 , a2 , a3 , a4 should be in one slide and object b1 , b2 , b3 , b4 on another slide.

       

      Thanks

       

       


      Sub Exportpower

      'ActiveDocument.ActiveSheet.FitZoomToWindow

      Set objPPT = CreateObject("PowerPoint.Application")
      objPPT.Visible = True
      Set objPresentation = objPPT.Presentations.Add

      aSheetObj =Array("a1","a2","a3" )
      aSheetObjj=Array("b1","b2","b3" )
      aSheetObjk=Array("c1","c2","c3" )
      aSheetObjl=Array("d1","d2","d3" )

      'for z=0 to 1


      Set PPSlide = objPresentation.Slides.Add(1,1)
      PPSlide.Shapes(1).Delete ' removes the title
      PPSlide.Shapes(1).Delete ' removes the text box


      for i=0 to uBound(aSheetObj)
      ActiveDocument.GetSheetObject(aSheetObj(i)).CopyBitmapToClipboard
      with PPSlide.Shapes.Paste

      .Left = 0
      .top = 60
      .width=360
      end with

      next

      for k=0 to UBound(aSheetObjj)
      ActiveDocument.GetSheetObject(aSheetObjj(k)).CopyBitmapToClipboard
      with PPSlide.Shapes.Paste


      .Left = 361
      .top = 60
      .width=360
      end with
      next

      for l=0 to UBound(aSheetObjk)
      ActiveDocument.GetSheetObject(aSheetObjk(l)).CopyBitmapToClipboard
      with PPSlide.Shapes.Paste

      .Left = 0
      .top = 260
      .width=360
      end with
      next

      for m=0 to UBound(aSheetObjl)
      ActiveDocument.GetSheetObject(aSheetObjl(m)).CopyBitmapToClipboard
      with PPSlide.Shapes.Paste

      .Left = 361
      .top = 260
      .width=360
      end with
      next

      'next
      Set PPSlide = Nothing
      Set PPPres = Nothing

      End sub