有没有一种方法可以使用 VBA 将 excel 中分组的多个图表复制并粘贴到 powerpoint？

Question

有没有一种方法可以让我从 excel 复制粘贴多个图表，这些图表分成四个部分，如下所示，到我现有的 powerpoint 幻灯片 28 和幻灯片 29？组的名称是 group 16 为左组，group 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

有没有一种方法可以使用 VBA 将 excel 中分组的多个图表复制并粘贴到 powerpoint？

Is there a way to copy and paste multiple charts that are grouped in excel to powerpoint using VBA?

excel

charts

powerpoint

vba