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

Question

有没有办法让我可以将多个图表（如下所示）从 excel 中的四个分组复制并粘贴到我现有的 powerpoint 幻灯片 28 和幻灯片 29？ 组的名称为左组为第 16 组，右组为第 17 组。 我曾尝试使用 Chrt.CopyPicture 但它只将图表单独复制到幻灯片而不是像下图左侧显示的 4 个图表上的一个大纲那样的组。 顺便说一下，我唯一的代码只将图表单独复制到第 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

目前，图表单独复制到ppt幻灯片

预期的

Answer 1

这对我有用。

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