macro to copy chart from excel to powerpoint

Dear Rich,

Above macro works flawlessly. thank you

Would it be possible to focus it on a single SHEET only. Basically I have numberous of sheets with figures & data & divided into 6 or more sections. Each section will a Chart and the data link to the chart and "backup" (which is the copy of the chart ( converted to picture only (jpeg) and data is converted to text only).

These "BackUp" sheet. This sheet is a copy of the active chart into picture form (jpeg or png - hard copy) but it is not linked any data (it's just a picture).

The picture will change per country etc (on column A). In this sheet alone has 14 pictured charts. Would it be possible to just move these 14 pictures (#will vary) on this sheet into a ppt (in jpeg etc).

The link that I provide was the sheet I would like to focus on.

https://skydrive.live.com/embed?cid=1B7A1F7F35D8435F&resid=1B7A1F7F35D8435F%21181&authkey=ADajXsXRZZmon8Q&em=2

Hi,

Not sure what you're asking for here.  Which charts on which sheet do you want to copy?

And where should they be copied to?  - to PowerPoint?, or to another sheet in Excel (if so which sheet in which workbook?)?

To just copy all the charts from one worksheet to PowerPoint, you could use:

Sub PushChartsToPPT()

'Set reference to 'Microsoft PowerPoint 1x.0 Object Library'

'in the VBE via Tools > References...

'

    'No need for the reference if we use Late Binding:

    Dim ppt As Object 'PowerPoint.Application

    Dim pptPres As Object 'PowerPoint.Presentation

    Dim pptSld As Object 'PowerPoint.Slide

    Dim pptCL As Object 'PowerPoint.CustomLayout

    Dim pptShp As Object 'PowerPoint.Shape

    Dim cht As Chart

    Dim ws As Worksheet

    Dim i As Long

'Get the PowerPoint Application object:

    Set ppt = CreateObject("PowerPoint.Application")

    ppt.Visible = msoTrue

    Set pptPres = ppt.Presentations.Add

    DoEvents   'give the new presentation a chance to open...

    DoEvents   'found this was necessary if there was already

    DoEvents   'a PowerPoint presentation open!

'Get a Custom Layout:

    For Each pptCL In pptPres.SlideMaster.CustomLayouts

        If pptCL.Name = "Title and Content" Then Exit For

    Next pptCL

'Copy ALL charts embedded in ONE WorkSheet:

    With ActiveWorkbook.Worksheets("SheetName")

         For i = 1 To .ChartObjects.Count

             Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)

             pptSld.Select

             For Each pptShp In pptSld.Shapes.Placeholders

If pptShp.PlaceholderFormat.Type = 7 Then Exit For   '7 = ppPlaceholderObject

             Next pptShp

             Set cht = .ChartObjects(i).Chart

             cht.ChartArea.Copy

             ppt.Activate

             pptShp.Select

             ppt.Windows(1).View.PasteSpecial ppPasteEnhancedMetafile

         Next i

     End With

End Sub

Cheers

Rich

Dear Rich,

I'm sorry for the confusion. Your previous macro took only active charts but I would like it to take the copy charts that I place in the "backUp" sheets.

I have upload the actual file that I would be working on.

File Name: TOP20YOY, it has for sheets (Pivot, RankTemplate, ChartTemplate, YOY_BackUp)

I hope you have skydrive.

1. https://onedrive.live.com/embed?cid=1B7A1F7F35D8435F&resid=1B7A1F7F35D8435F%21185&authkey=ANDp1XliC1qz3lM

If you can't see this one Please use this older version which contains sheet YOY_backup only. FileName "example1xls-ppt"

2. https://onedrive.live.com/embed?cid=1B7A1F7F35D8435F&resid=1B7A1F7F35D8435F%21181&authkey=ADajXsXRZZmon8Q&em=2

Sheet 1: Pivot, 

Sheet 2: RankTemplate, 

Sheet 3: ChartTemplate, 

Sheet 4: YOY_BackUp

So I would like to only focus on Sheet 4: YOY_BackUp. Sheet 4 has multiplies copies of the charts (in jpeg) and the raw data next to it. So would it be possible to transfer those Jpeg chart into one PPT presentation in separate slides?

I hope this is clear.

Much help is appreciated.

Ian

Hi,

So you want to copy pictures, not charts!

Try this:

Sub PushPicturesToPPT()

'Set reference to 'Microsoft PowerPoint 1x.0 Object Library'

'in the VBE via Tools > References...

'

'No need for the reference if we use Late Binding:

    Dim ppt As Object  'PowerPoint.Application

    Dim pptPres As Object 'PowerPoint.Presentation

    Dim pptSld As Object  'PowerPoint.Slide

    Dim pptCL As Object  'PowerPoint.CustomLayout

    Dim pptShp As Object  'PowerPoint.Shape

    Dim shp As Shape

    Dim ws As Worksheet

     'Get the PowerPoint Application object:

    Set ppt = CreateObject("PowerPoint.Application")

    ppt.Visible = msoTrue

    Set pptPres = ppt.Presentations.Add

    DoEvents   'give the new presentation a chance to open...

    DoEvents   'found this was necessary if there was already

    DoEvents   'a PowerPoint presentation open!

'Get a Custom Layout:

    For Each pptCL In pptPres.SlideMaster.CustomLayouts

        If pptCL.Name = "Title and Content" Then Exit For

    Next pptCL

     'Copy ALL pictures embedded in ONE WorkSheet:

    For Each shp In ActiveWorkbook.Worksheets("YOY_BackUp").Shapes

        If shp.Type = msoPicture Then

           Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)

           pptSld.Select

           For Each pptShp In pptSld.Shapes.Placeholders

               If pptShp.PlaceholderFormat.Type = 7 Then Exit For   '7 = ppPlaceholderObject

           Next pptShp

           shp.Copy

           ppt.Activate

           pptShp.Select

           ppt.Windows(1).View.Paste

           'ppt.Windows(1).View.PasteSpecial ppPasteEnhancedMetafile

       End If

    Next shp

End Sub

Please test and let me know if it works.

Cheers

Rich

Rich,

This is great, sorry for the late reply. I've been very busy. THanks again.

Ian