vba - 将图表从 Excel 粘贴到特定布局中的特定占位符。简报 2010

Question

我需要将多个图表从 excel 粘贴到 powerpoint。我找到了一些优秀的 VBA 代码(主要在 Jon Peltier 的网站上)。现在我的 powerpoint 模板有多种布局(例如，1 个图表占据了大部分幻灯片或 1 个图表和一个幻灯片中的一个文本框，等等)。

我想要的是图表成为幻灯片布局的一部分，这样如果我重新格式化幻灯片 - 例如我按照上面给出的示例更改布局 - 图表将相应移动。目前，我能够以正确的大小和所有内容粘贴到占位符所在的位置，但它不在占位符中，而是在占位符上(因此，如果我更改布局，它会保留在那里)。

理想情况下，我希望能够选择布局(从 15 个中选择)并在所选布局中选择占位符(通常我有一个标题、一个页脚，然后是 1 到 4 个占位符用于图表、图像、文本或以上所有)。

我不是 VBA 程序员，我只是使用了一些逻辑和抓取代码，这些代码是在网上分享的。我不知道如何识别正确的布局(它们有名称，但那是变量吗？)，也不知道布局中的正确占位符(在这里我什至不知道如何识别它们)。

非常感谢任何帮助。东风

在下文中，我到处复制代码(主要是 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

Answer 1

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

您当前正在粘贴图表“On”Slide 1。您必须将其粘贴到“In”相关的 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

现在即使您更改布局，图表也会相应地移动。

快照