Trying to export charts from active sheet to ppt

[rmuhammad]

Hi All

I am trying to export charts from the active sheet to powerpoint. I am getting an error on getting sheet by using GetSheetByid(). my VB skills are rusted and in need of help by experts in this forum.

Sub Export_All_Chart_Images_Current_Sheet()

    set objPPT = CreateObject("PowerPoint.Application")

  objPPT.Visible = True

  Set objPresentation = objPPT.Presentations.Add

  'For i = 0 To ActiveDocument.NoOfSheets - 1

  msgbox(ActiveDocument.ActiveSheet.GetProperties.SheetId)

  'set MySheetID = right(ActiveDocument.ActiveSheet.GetProperties.SheetId,4)

  'set MySheetID= CHR(34)&right(ActiveDocument.ActiveSheet.GetProperties.SheetId,4)&CHR(34) '<<<<< I think PROBLEM is here

        Set MySheet = ActiveDocument.GetSheetByid (MySheetID)

        MyCharts=MySheet.GetSheetObjects

            For X =lbound(MyCharts) to ubound(MyCharts)

                   msgbox(X)

   Set PPSlide = objPresentation.Slides.Add(X+1,11)

                    'msgbox("Chart: " & MyCharts(X).GetObjectId)

                     Set obj = ActiveDocument.ActiveSheet.GetSheetObject(MyCharts(X).GetObjectId)

                     IF Obj.GetObjectType >= 10 AND Obj.GetObjectType =< 16 Then           

  obj.CopyBitmapToClipboard

  PPSlide.Shapes.Paste

  End if

            Next

'    Next 

    Set PPSlide = Nothing

  Set PPPres = Nothing

End Sub

Thanks

Rashid

[rmuhammad · Accepted solution]

Solved:

This code export charts from active sheet to power point

Sub Export_All_Chart_Images_Current_Sheet()

    set objPPT = CreateObject("PowerPoint.Application")

  objPPT.Visible = True

  Set objPresentation = objPPT.Presentations.Add

        Set MySheet = ActiveDocument.GetSheetByid (right(ActiveDocument.ActiveSheet.GetProperties.SheetId,4))

        MyCharts=MySheet.GetSheetObjects

            For X =lbound(MyCharts) to ubound(MyCharts)

                   msgbox(X)

   Set PPSlide = objPresentation.Slides.Add(X+1,11)

                    'msgbox("Chart: " & MyCharts(X).GetObjectId)

                     Set obj = ActiveDocument.GetSheetObject(MyCharts(X).GetObjectId)

                     IF Obj.GetObjectType >= 10 AND Obj.GetObjectType =< 16 Then           

  obj.CopyBitmapToClipboard

  PPSlide.Shapes.Paste

  End if

            Next

'    Next 

    Set PPSlide = Nothing

  Set PPPres = Nothing

End Sub