从Excel导出到PowerPoint时如何定义图表顺序?

时间:2016-05-02 12:50:27

标签: excel vba charts

我创建了一张所有图表所在的工作表,然后我使用宏将图表导出到PowerPoint中。

如何定义图表插入演示文稿的顺序?我尝试将它们命名为图表1,图表2等,但它没有用。

这是宏代码:

 'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject

'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
    Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
    newPowerPoint.Presentations.Add
End If

'Show the PowerPoint
newPowerPoint.Visible = True

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects

'Add a new slide where we will paste the chart
    newPowerPoint.ActivePresentation.Slides._
Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
    newPowerPoint.ActiveWindow.View._
GotoSlide newPowerPoint.ActivePresentation.Slides.Count
    Set activeSlide = newPowerPoint.ActivePresentation._
Slides(newPowerPoint.ActivePresentation.Slides.Count)

'Copy the chart and paste it into the PowerPoint as a Metafile Picture
    ActiveSheet.Unprotect "password"
    cht.Select
    ActiveChart.ChartArea.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    ActiveSheet.Protect "password"

'Set the title of the slide the same as the title of the chart
    'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

'Adjust the positioning of the Chart on Powerpoint Slide
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 1
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 1

    'activeSlide.Shapes(2).Width = 200
    'activeSlide.Shapes(2).Left = 505

Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

1 个答案:

答案 0 :(得分:1)

如果您将图表命名为Chart1,Chart2等,则只需调整循环即可按照命名顺序执行图表。

将iCht声明为Long,然后将循环更改为:

For iCht = 1 To ActiveSheet.ChartObjects.Count Set cht = ActiveSheet.ChartObjects("Chart" & CStr(iCht))

我认为你的代码的其余部分代表了。