excel - 如何将 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 上编辑了文本框。
解决方案
我相信如果您更正 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
推荐阅读
- authentication - 使用 OpenLDAP 进行 Kerberos 身份验证
- vue.js - Nuxt - “纱线生成”后页面无法正确加载
- django - 无法使用具体视图 django rest 框架上传 Img
- swift - UItableView automaticDimension 不适用于 UIStackView
- android - 在活动布局文件中添加片段代码有什么用?
- python - flask / flask_restful :从另一个蓝图中的另一条路由调用一个蓝图中的路由
- c++ - 我该如何解决(没有匹配函数调用 'Hospital::Hospital()'| )
- azure-devops - Azure DevOps Server dotnet restore 无权访问源
- flutter - Flutter - 如何正确显示组合的 SVG 图像
- reactjs - ReactJS 给了我一个未定义的错误,即使我已经定义了它