有没有办法使用 VBA 将在 excel 中分组的多个图表复制并粘贴到 powerpoint？

Question

Is there a way such that i can copy and paste multiple charts that are grouped in four as shown below from excel to my existing powerpoint slides 28 and slides 29? The name of the groups are group 16 for the left group, group 17 for the right group. I have tried to use Chrt.CopyPicture but it only copies charts separately to the slides instead of a group like the one outline on the 4 charts shown on the left side of the picture below. By the way, my only code only copies charts individually to slide 28.

Sub ExportChartsTopptSingleWorksheet()

    'Declare PowerPoint Variables
    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTShape As Object
    Dim mySlide, myslide2 As Object

    'Declare Excel Variables
    Dim Chrt As ChartObject


If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")

On Error GoTo 0
        PPTApp.Visible = True

    'Create new presentation in the PowerPoint application.
      Set PPTPres = PPTApp.Presentations.Open(Filename:="\\fab2crp-nas1\home22\kkang2\Profile\Desktop\myassignment3\mypresentationsample.pptx")

    Set mySlide = PPTPres.Slides.Add(28, 1) 

        'Loop through all the CHARTOBJECTS in the ACTIVESHEET.
        For Each Chrt In ActiveSheet.ChartObjects

            'Copy the Chart
            Chrt.CopyPicture  '<------ method copy fail error here                     

      'paste all the chart on to exisitng ppt slide 28
                mySlide.Shapes.Paste
           Next Chrt

    End Sub

Currently, charts are copied individually to ppt slides

Expected

Answer 1

This worked for me.

Sub ExportChartsTopptSingleWorksheet()

    Const PER_ROW As Long = 2 'charts per row in PPT
    Const T_START As Long = 40 'start chart top
    Const L_START As Long = 40 'start chart left

    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTShape As Object
    Dim mySlide, myslide2 As Object, i As Long
    Dim Chrt As ChartObject, T As Long, L As Long


    If PPTApp Is Nothing Then _
    Set PPTApp = CreateObject(class:="PowerPoint.Application")
    PPTApp.Visible = True
    Set PPTPres = PPTApp.Presentations.Add()

    Set mySlide = PPTPres.Slides.Add(1, 1)

    i = 0
    For Each Chrt In ActiveSheet.ChartObjects
        Chrt.Chart.CopyPicture
        i = i + 1
        'work out the top/left values
        T = T_START + (Application.Floor((i - 1) / PER_ROW, 1)) * Chrt.Height
        L = L_START + ((i - 1) Mod PER_ROW) * Chrt.Width
        With mySlide.Shapes
            .Paste
            .Item(.Count).Top = T
            .Item(.Count).Left = L
        End With
    Next Chrt

End Sub