VBA将同一工作表中的多个图表（每次4个）导出到一个powerpoint幻灯片中

Question

I've been trying to export multiple excel charts into powerpoint but there is a catch...I'd like to export 4 charts into a single slide at a time.

I've found the following code but it needs to be modify so that 4 charts are exported into one slide, instead of a single chart per slide.

The code is below:

Thanks!

Sub PushChartsToPPT()

    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 1

Try this:

For Each ws In ActiveWorkbook.Worksheets
    For i = 1 To ws.ChartObjects.Count Step 4 'your count must be a multiple of four other it wouldn't work
        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
        For j = 0 to 3 
        Set cht = ws.ChartObjects(i+j).Chart
        cht.ChartArea.Copy
        ppt.Activate
        pptShp.Select
        ppt.Windows(1).View.Paste
        Next J
    Next i