将图表从Excel复制到PowerPoint并使用VBA保持源格式

时间:2018-01-02 16:47:02

标签: excel vba excel-vba powerpoint

我正在循环使用excel工作簿的工作表,并尝试绘制一些图表,然后在PowerPoint演示文稿中浏览这些图表。

我的伪代码看起来像这样

Dim counter As Integer
counter = 2

for each ws in ActiveWorkbook.Worksheets
   Dim myChart2 As Chart
   Set myChart2 = ws.Shapes.AddChart.Chart
   'DO chart stuff

   Set ppSlide = ppPres.Slides.Add(counter, ppLayoutTitleOnly)
      With ppSlide.Shapes
        If Not .HasTitle Then
            .AddTitle.TextFrame.TextRange.Text = "Title"
        End If
        ppSlide.Shapes.Title.TextFrame.TextRange.Text = ws.Name

         myChart2.ChartArea.Copy

         ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting")

      End With
    counter = counter + 1
    ws.ChartObjects.Delete


Next ws

不幸的是,所有图表都被转储在第一张幻灯片上,而不是每张幻灯片上的每张图表。有人能帮我纠正这个吗?

1 个答案:

答案 0 :(得分:1)

试试这个:

Dim PPSlide As PowerPoint.Slide

for each ws in ActiveWorkbook.Worksheets
   Dim myChart2 As Chart
   Set myChart2 = ws.Shapes.AddChart.Chart
   'DO chart stuff

   Set ppSlide = ppPres.Slides.Add(counter, ppLayoutTitleOnly)
      With ppSlide.Shapes
        If Not .HasTitle Then
            .AddTitle.TextFrame.TextRange.Text = "Title"
        End If
        ppSlide.Shapes.Title.TextFrame.TextRange.Text = ws.Name

        'Add slide to presentation
        PPApp.ActivePresentation.Slides.Add _
            PPApp.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
        PPApp.ActiveWindow.View.GotoSlide _
            PPApp.ActivePresentation.Slides.Count
        Set PPSlide = PPApp.ActivePresentation.Slides( _
            PPApp.ActivePresentation.Slides.Count)

       ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting")
       ...