从Excel图表粘贴到一个特定布局的具体占位符。 Powepoint 2010(Paste a

我需要多个图表粘贴从Excel到PowerPoint。我发现一些优秀的VBA代码（主要是乔恩·珀尔帖的网站）。现在我的PowerPoint模板有许多布局（如1个图表占据了大部分的幻灯片或者1个图表和幻灯片，等等等等一个文本框）。

我要的是成为幻灯片布局的一部分，所以，如果我重新格式化幻灯片图表 - 例如，我改变布局在上面给出的例子 - 图表将相应移动。目前我能在其中占位符是，用大小合适，一切都当场粘贴，但它不是在占位符，它是在占位符（因此，如果我改变布局它就留在那里）。

理想情况下，我想能够选择布局（15），选择占位符中所选择的版式（通常我有一个标题，页脚，然后从1至4占位符，图表，图像，文本或全部以上）。

我不是一个VBA程序员，我只是使用它在网络上共享亲切逻辑和抢码一点点。我没有线索如何确定正确的布局（他们的名字，但是是变量？）也没有布局内适当的占位符（在这里我甚至不知道如何识别它们）。

任何帮助非常赞赏。 DF

在下文中，代码我复制在这里和那里（主要是乔恩·珀尔帖的网站）。

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

如果我理解你的问题，那么我认为这是你想要的。

您正在粘贴图“ 在 ” Slide 1 。你必须粘贴“ 在 ”有关Place Holder在Slide 1 。

修改你的代码将这一（ 久经考验的 ）

Dim nPlcHolder As Long

With PPPres
    nPlcHolder = 2 '<~~ The place holder where you have to paste

    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    .Windows(1).View.PasteSpecial (ppPasteMetafilePicture)
End With

现在，即使你改变你的布局，图表也会相应变化。

快照

HTH