excel macro to paste 4 charts on a single slide in powerpoint ... RRS feed

  • Question

  • i have multiple workbooks, each workbook has NN sheets, each sheet has 5 charts, 4 of the charts are in a rectangle on the sheet.

    i need to paste the 4 charts into a single slide in powerpoint deck.

    then add a new slide for the next sheet in the workbook.

    code below only handles the current sheet, and paste each chart pasted replaces the previous ... so i end up with only 1 chart pasted in the slide ...


    1. correct code below to paste each of the four excel charts into a single slide without overwriting each other

    2. extend with loop for each sheet, adding a new slide for the new sheet ...

    Thanks ...

            For Each cht In ActiveSheet.ChartObjects
                If chtcount = 4 Then
                If chtcount = 1 Then
            'Add a new slide where we will paste the chart
                newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
                End If
                chtcount = chtcount + 1
                newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
                Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
            'Copy the chart and paste it into the PowerPoint as a Metafile Picture

                ' Copy Chart
                ' Paste Chart
            'Set the title of the slide the same as the title of the chart
            If chtcount = 1 Then
                activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
            End If
            If chtcount Mod 2 = 1 Then
                leftpos = 0
                leftpos = 500
            End If
            If chtcount <= 2 Then
                toppos = 30
                toppos = 530
            End If
            'Adjust the positioning of the Chart on Powerpoint Slide
                newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = leftpos '15
                newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = toppos '125

                activeSlide.Shapes(2).Width = 200
                activeSlide.Shapes(2).Left = 505

    Wednesday, June 17, 2015 5:14 PM


  • Hi,

    Based on the understanding, you are going to loop each sheet in the workbook, and copy the chart to  a new created Slide in the Presentation. You may use the following code as a reference.

    Sub CopyCharts()
    Dim PPT As PowerPoint.Application
    Set PPT = New PowerPoint.Application
    PPT.Visible = msoCTrue
    Dim MyPresention As Presentation
    ‘Open the PPT
    PPT.Presentations.Open Filename:="D:\Test.pptx"
    Set MyPresention = PPT.Presentations("Test.pptx")
    Dim MySlide As PowerPoint.Slide
    Dim oLayout As CustomLayout
    Set oLayout = MyPresention.Designs(1).SlideMaster.CustomLayouts(7)
    For Each ws In ActiveWorkbook.Worksheets
    'Add a new Slide
    MyPresention.Slides.AddSlide MyPresention.Slides.Count + 1, oLayout
    ' Use Index to Select Chart ,Copy and Paste Chart
    Dim crt As ChartObject
    For i = 2 To 5
    Set crt = ActiveSheet.ChartObjects(i)
    MyPresention.Slides(MyPresention.Slides.Count).Shapes(i - 1).Left = 20 + (i - 2) * 120 + 100
    ' Set the Left Property for the Pasted Chart to Preventing Override the previous Shape
    Next i
    End Sub

    Hope this could help you

    Best Regards,


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    • Marked as answer by L.HlModerator Wednesday, July 1, 2015 6:02 PM
    Tuesday, June 30, 2015 6:11 AM