使用VBA将Excel图表粘贴到Powerpoint中 [英] Paste Excel Chart into Powerpoint using VBA

问题描述

我正在尝试创建一个excel宏，复制excel表上显示的图表，并将它们粘贴到PowerPoint中。我遇到的问题是如何将每个图表粘贴到其他幻灯片上？我不知道所有的语法。

I'm trying to create an excel macro that copies charts displayed on an excel sheet, and pastes them (paste special) into a PowerPoint. The problem I'm having is how do I paste each chart on a different slide? I do not know the syntax at all..

这是我迄今为止（它的作品，但它只粘贴到第一张）：

This is what I have so far (it works but it only pastes to the first sheet):

Sub graphics3()

Sheets("Chart1").Select
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartArea.Copy
Sheets("Graphs").Select
range("A1").Select
ActiveSheet.Paste
     With ActiveChart.Parent
     .Height = 425 ' resize
     .Width = 645  ' resize
     .Top = 1    ' reposition
     .Left = 1   ' reposition
 End With

Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="locationwherepptxis"

Set PPApp = GetObject("Powerpoint.Application")
Set PPPres = PPApp.activepresentation
Set PPSlide = PPPres.slides _
    (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
    Format:=xlPicture

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

推荐答案

鉴于我没有您的文件位置，我已经附上了一个例程，

Given I dont have your file locations to work with I have attached a routine below that

1. 创建了一个新的PowerPoint实例（后期绑定，因此需要为ppViewSlide等定义常量）


2. 通过每个图表循环


3. 添加新幻灯片


4. 粘贴每个图表，然后重复

1. Created a new instance of PowerPoint (late binding, hence the need to define constants for ppViewSlide etc)
2. Loops through each chart in a sheet called Chart1 (as per your example)
3. Adds a new slide
4. Pastes each chart, then repeats

您需要在导出大小之前格式化每张图表，还是更改默认图表大小？

Did you need to format each chart picture before exporting for size, or can you change your default chart size?

Const ppLayoutBlank = 2
Const ppViewSlide = 1

Sub ExportChartstoPowerPoint()
    Dim PPApp As Object
    Dim chr
    Set PPApp = CreateObject("PowerPoint.Application")
    PPApp.Presentations.Add
    PPApp.ActiveWindow.ViewType = ppViewSlide
    For Each chr In Sheets("Chart1").ChartObjects
        PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
        PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
        chr.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        PPApp.ActiveWindow.View.Paste
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    Next chr
    PPApp.Visible = True
End Sub

这篇关于使用VBA将Excel图表粘贴到Powerpoint中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！