首页 > 解决方案 > 如何将 Excel 图表复制到 PowerPoint 幻灯片中?

问题描述

如何将 Excel 图表复制到 PowerPoint 幻灯片中?

这是我到目前为止的代码。

'There is a bunch of other stuff defined.
' Just showing what I think are relevant definitions
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim shp As PowerPoint.Shape
Dim sld As PowerPoint.Slide
Dim xlChrt As Excel.ChartObject

Set pptApp = CreateObject("PowerPoint.Application")

'This opens up my PowerPoint file
Set ppPres = pptApp.Presentations.Open(myPath & pptFile)

'This activates the worksheet where my chart is
Workbooks(wb2).Sheets("Sheet 1").Activate

    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartArea.Copy

'I think that my copying works because after I run the module,
' I have the chart in my clipboard. 

'This takes me to slide 2 of my PowerPoint. 
Set sld = pptPres.Slides(2) 

sld.Shapes.Paste 'But nothing pastes to the slide

我正在复制图表,因为它在模块运行后位于我的剪贴板中。

我成功地在代码中引用了 PowerPoint 幻灯片,我在幻灯片 2 上编辑了文本框。

标签: excelvbapowerpoint

解决方案


我相信如果您更正 set pptPres 语句,您的代码应该可以工作。此示例是基于您的代码的简化示例:

Option Explicit

Public Sub CopyChart()

    Const myPath = "c:\temp\"
    Const pptFile = "test.pptx"

    Dim pptApp As New PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim sld As PowerPoint.Slide

    ' Open the PowerPoint and reference the slide
    Set pptPres = pptApp.Presentations.Open(myPath & pptFile)
    Set sld = pptPres.Slides(2)

    ' Copy the Chart
    ActiveWorkbook.Sheets("Sheet 1").ChartObjects("Chart 1").Copy

    ' Paste it into the PowerPoint
    sld.Shapes.Paste

End Sub

结果……您可以看到粘贴到幻灯片 2 上的图表:

屏幕复制

更新的答案

图表的功能不如嵌入式图表:https://docs.microsoft.com/en-us/office/vba/api/excel.chart(object)

这是一个选项,它是上述适用于图表的小变体:

Option Explicit

Public Sub CopyChartSheet()

    Const myPath = "c:\temp\"
    Const pptFile = "test.pptx"

    Dim pptApp As New PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim myChart As Excel.Chart

    Dim sld As PowerPoint.Slide

    ' Open the PowerPoint and reference the slide
    Set pptPres = pptApp.Presentations.Open(myPath & pptFile)
    Set sld = pptPres.Slides(2)

    ' Copy the Chart
    Set myChart = ActiveWorkbook.Charts("Chart 1")
    myChart.CopyPicture

    ' Paste it into the PowerPoint
    sld.Shapes.Paste

End Sub

屏幕2


推荐阅读