我需要将多个Excel图表粘贴到PowerPoint中。
我找到了一些优秀的VBA代码(主要在Jon Peltier的网站上)。
现在我的PowerPoint模板有多个布局(例如,一个幻灯片上占据大部分空间的1个图表或1个图表和一个文本框等等)。
我希望图表成为幻灯片布局的一部分,这样如果我重新格式化幻灯片 - 例如,像上面给出的示例更改布局 - 图表将相应移动。 目前,我能够在占位符所在的位置粘贴,并且大小合适,但它不在占位符内,而是在占位符上(因此,如果我更改布局,它将留在那里)。
理想情况下,我希望能够选择布局(共15种)并选择所选布局中的占位符(通常我有一个标题、页脚,然后从1到4个用于图表、图像、文本或所有这些的占位符)。
我不是VBA程序员,我只是使用一点逻辑并抓取在网络上慷慨分享的代码。我不知道如何识别正确的布局(它们有名称,但那是变量吗?),也不知道如何识别布局中的正确占位符(在这里,我甚至不知道如何识别它们)。
非常感谢任何帮助。 DF
以下是我从这里和那里复制的代码(主要来自Jon Peltier的网站)。
我希望图表成为幻灯片布局的一部分,这样如果我重新格式化幻灯片 - 例如,像上面给出的示例更改布局 - 图表将相应移动。 目前,我能够在占位符所在的位置粘贴,并且大小合适,但它不在占位符内,而是在占位符上(因此,如果我更改布局,它将留在那里)。
理想情况下,我希望能够选择布局(共15种)并选择所选布局中的占位符(通常我有一个标题、页脚,然后从1到4个用于图表、图像、文本或所有这些的占位符)。
我不是VBA程序员,我只是使用一点逻辑并抓取在网络上慷慨分享的代码。我不知道如何识别正确的布局(它们有名称,但那是变量吗?),也不知道如何识别布局中的正确占位符(在这里,我甚至不知道如何识别它们)。
非常感谢任何帮助。 DF
以下是我从这里和那里复制的代码(主要来自Jon Peltier的网站)。
Sub ChartToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim AddSlidesToEnd As Boolean
AddSlidesToEnd = True
' Make sure a chart is selected
If ActiveChart Is Nothing Then
MsgBox "Please select a chart and try again.", vbExclamation, _
"No Chart Selected"
Else
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copy chart
ActiveChart.ChartArea.Copy
' Paste chart
PPSlide.Shapes.Paste.Select
' Position pasted chart
' This is the keypoint
' I want to replace this with the selection of appropriate layout
' and placeholder in that layout
PPApp.ActiveWindow.Selection.ShapeRange.Left = 19.56
PPApp.ActiveWindow.Selection.ShapeRange.Top = 66.33
PPApp.ActiveWindow.Selection.ShapeRange.Width = 366.8
PPApp.ActiveWindow.Selection.ShapeRange.Height = 424.62
If PPApp.ActivePresentation.Slides.Count = 0 Then
' Other key point
' can I add a specific layout, for example one named Two Content Layout + takeout
Set PPSlide = PPApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Else
If AddSlidesToEnd Then
'Appends slides to end of presentation and makes last slide active
PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
Set PPSlide = PPApp.ActivePresentation.Slides(PPApp.ActivePresentation.Slides.Count)
Else
'Sets current slide to active slide
Set PPSlide = PPApp.ActiveWindow.View.Slide
End If
End If
'Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If
End Sub