macro to copy chart from excel to powerpoint

Question

is there a way i can get a macro to copy a chart from excel into power point? I know how to do it for tables within the actual sheet, but cannot seem to get the chart to copy as i cannot use cell ranges.

Thanks

Answer 1

OK, well this one copies ALL charts from ALL Chart Sheets, and then ALL charts embedded in EACH worksheet.

You need to set a reference to 'Microsoft PowerPoint 12.0 Object Library' in the VBE via Tools > References...

Paste the code below into a code module in Excel.

Sub PushChartsToPPT()

'Set reference to 'Microsoft PowerPoint 12.0 Object Library''in the VBE via Tools > References...'    Dim ppt As PowerPoint.Application

    Dim pptPres As PowerPoint.Presentation

    Dim pptSld As PowerPoint.Slide

    Dim pptCL As PowerPoint.CustomLayout

    Dim pptShp As 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

   

 '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 in Chart Sheets:    For Each cht In ActiveWorkbook.Charts

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

        pptSld.Select

       

        For Each pptShp In pptSld.Shapes.Placeholders

            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For

        Next pptShp

        If pptShp Is Nothing Then Stop

       

        cht.ChartArea.Copy

        ppt.Activate

        pptShp.Select

        ppt.Windows(1).View.Paste

    Next cht

   

   'Copy ALL charts embedded in EACH WorkSheet:    For Each ws In ActiveWorkbook.Worksheets

        For i = 1 To ws.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 = ppPlaceholderObject Then Exit For

            Next pptShp

           

            Set cht = ws.ChartObjects(i).Chart

            cht.ChartArea.Copy

            ppt.Activate

            pptShp.Select

            ppt.Windows(1).View.Paste

        Next i

    Next ws

End Sub

 

Hope that helps.

 

Cheers

Rich

Hi Rich,

I modified the above as follows, which works perfectly, thank you!  However, is there a way to modify the VB code to set the "Title" of the slide to be the same as the title of the chart?  My charts are formatted to display a title above the chart?  As it is written now, my title is displayed above the chart in the slide but I also get a blank "Title" box above it.

Thank you in advance,

Brenda

Sub PushChartsToPPT()

 'Set reference to 'Microsoft PowerPoint 12.0 Object Library'

 'in the VBE via Tools > References...

 '

     Dim ppt As PowerPoint.Application

     Dim pptPres As PowerPoint.Presentation

     Dim pptSld As PowerPoint.Slide

     Dim pptCL As PowerPoint.CustomLayout

     Dim pptShp As 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

     '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 EACH WorkSheet:

     For Each ws In ActiveWorkbook.Worksheets

         For i = 1 To ws.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 = ppPlaceholderObject Then Exit For

             Next pptShp

            Set cht = ws.ChartObjects(i).Chart

             cht.ChartArea.Copy

             ppt.Activate

             pptShp.Select

             ppt.Windows(1).View.Paste

         Next i

     Next ws

 End Sub

Answer 2

I modified the above as follows, which works perfectly, thank you!  However, is there a way to modify the VB code to set the "Title" of the slide to be the same as the title of the chart?  My charts are formatted to display a title above the chart?  As it is written now, my title is displayed above the chart in the slide but I also get a blank "Title" box above it.

Hi,

I think you simply need to add this line immediately after ppt.Windows(1).View.Paste

            pptSld.Shapes.Title.TextFrame.TextRange.Text = cht.ChartTitle.Text

(but I can't test this right now - let me know if it doesn't work as intended).

Cheers

Rich

Answer 3

Rich, thank you for the speedy response!

This mod worked perfectly!  The one other thing I did after, because the title gets listed twice - once in the chart the other in the title of the PPT is go in and change the font to white on the chart in excel and it magically disappears! 

Thank you!

Brenda

Answer 4

Thank you Rich,

But i am not able to import images to powerpoint slides.One more porblem is that how we varying the size,location on which we have to link charts and images.Please help out with some changes in code.

Answer 5

Hi Rich,

I used your above given code and i want to use some specific template so also used your comment but this is inserting charts in the end slides of template and need to specific slide and placeholder function syntax is not doing any changes.

Please suggest chages to fix this.

Sub PushChartsToPPT()

'Set reference to 'Microsoft PowerPoint 12.0 Object Library'

'in the VBE via Tools > References...

'

    Dim ppt As PowerPoint.Application

    Dim pptPres As PowerPoint.Presentation

    Dim pptSld As PowerPoint.Slide

    Dim pptCL As PowerPoint.CustomLayout

    Dim pptShp As PowerPoint.Shape

    Dim cht As Chart

    Dim ws As Worksheet

    Dim i As Long

     Dim strPptTemplatePath As String

    strPptTemplatePath = "E:\Macro\demo template.pptx"

     'Get the PowerPoint Application object:

    Set ppt = CreateObject("PowerPoint.Application")

    ppt.Visible = msoTrue

    Set pptPres = ppt.Presentations.Open(strPptTemplatePath, untitled:=msoTrue)

     '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 in Chart Sheets:

    For Each cht In ActiveWorkbook.Charts

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

        pptSld.Select

        For Each pptShp In pptSld.Shapes.Placeholders

            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For

        Next pptShp

        If pptShp Is Nothing Then Stop

        cht.ChartArea.Copy

        ppt.Activate

        pptShp.Select

        ppt.Windows(1).View.Paste

    Next cht

     'Copy ALL charts embedded in EACH WorkSheet:

    For Each ws In ActiveWorkbook.Worksheets

        For i = 1 To ws.ChartObjects.Count

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

            pptSld.Select

            'Find the right placeholder to paste into:

        For Each pptShp In pptSld.Shapes.Placeholders

            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then

                If pptShp.Left = 50 Then Exit For

            End If

        Next pptShp

            For Each pptShp In pptSld.Shapes.Placeholders

                If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For

            Next pptShp

            Set cht = ws.ChartObjects(i).Chart

            cht.ChartArea.Copy

            ppt.Activate

            pptShp.Select

            ppt.Windows(1).View.Paste

        Next i

    Next ws

End Sub

Thanks