VBA:将所选图表从 Excel 复制 + 粘贴到 Powerpoint

Question

我正在寻找复制和粘贴选定图表从 Excel 2010 到 Powerpoint 2010 作为 Microsoft Excel 图表对象格式转换为 活跃 PPT幻灯片。理想情况下，我希望能够将这些图表放在事件 Powerpoint 幻灯片上的特定位置。我在网上搜索过，但如果不是大多数解决方案，所有解决方案都是将工作表中的所有幻灯片随机粘贴到 PPT 幻灯片上。我什至没有代码，但如果有人可以提供帮助，那就太棒了。谢谢!

Answer 1

好吧，这里有一些东西:这是我前段时间写的一个 pptGenerator 类。
在我的场景中，我想右键单击工作簿中的特定图表，将“复制到演示文稿”作为自定义上下文菜单中的选项，然后在同一演示文稿或新演示文稿中的后续幻灯片上添加后续图表。
这些图表是在另一个类中捕获的，以便创建上下文菜单，并在传递给幻灯片时将其自身复制到幻灯片中。
下面是一个稍微修改和剥离的版本，它应该可以帮助您通过编辑此类来解决您的具体情况。

在类模块中:

'PowerPoint Generator class - Rik Sportel
'Maintains a PowerPoint application for Excel workbook.
Private WithEvents pptApp As PowerPoint.Application
Private ppt As PowerPoint.Presentation
Private pptPresentations As Collection 'Collection to add presentations to
Private p_currentPresentation As Boolean

'Make sure you don't add slides if there is no presentation.
Public Property Get CurrentPresentation() As Boolean
    CurrentPresentation = p_currentPresentation
End Property

'Initialization
Private Sub Class_Initialize()
    p_currentPresentation = False
    Set pptApp = New PowerPoint.Application
    Set pptPresentations = New Collection
End Sub

'Termination
Private Sub Class_Terminate()
    Set pptPresentations = Nothing
    Set pptApp = Nothing
End Sub

'Creates a new Presentation in the powerpoint app, and adds it to the pptPresentations collection. Add methods later to cycle through them.
Public Sub NewPresentation()
    Set ppt = pptApp.Presentations.Add
    pptPresentations.Add ppt

    'Create presentation and use image stored within the current workbook as a background for it.
    ThisWorkbook.Worksheets("BGItems").Shapes(1).Copy 'Copy the background
    ppt.Windows(1).ViewType = ppViewSlideMaster
    ppt.Windows(1).View.Paste 'Paste the background
    ppt.Windows(1).ViewType = ppViewNormal

    p_currentPresentation = True
End Sub

'Add a slide to the presentation, place passed chart on it.
Public Sub AddSlide(chartForSlide As Chart)
    Dim nSlide As PowerPoint.Slide
    Dim nChart As PowerPoint.Shape

    'Create a new slide with the chart on it.
    Set nSlide = pptApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)

    chartForSlide.ChartArea.Copy
    nSlide.Shapes.Paste 'Paste the chart
    Set nChart = nSlide.Shapes(1)

    'Position the chart
    With nChart
        .Left = ppt.PageSetup.SlideWidth / 10
        .top = ppt.PageSetup.SlideHeight / 10
        .Width = ppt.PageSetup.SlideWidth / 100 * 80
        .Height = ppt.PageSetup.SlideHeight / 2
    End With

    Set nChart = Nothing
    Set nSlide = Nothing
End Sub

'Make sure to keep track of presentations properly if users interact with
'powerpoint in unexpected ways. Capture event and make sure the presentation object you write to will still exist.
Private Sub pptApp_PresentationClose(ByVal Pres As PowerPoint.Presentation)
    For i = pptPresentations.Count To 1 Step -1
        If pptPresentations.Item(i) Is Pres Then
            pptPresentations.Remove i
        End If
    Next i
    If Pres Is ppt Then
        Set ppt = Nothing
        p_currentPresentation = False
    End If
End Sub

在我的“工厂”模块中。常规代码模块:

Public Sub GetPowerpoint()
    If pptApp Is Nothing Then Set pptApp = New pptGenerator
End Sub

如何使用:

'Pass a chart + optionally if it has to be a new presentation:
Public Sub CopyChartToPpt(tChart As Chart, Optional newPres As Boolean)
    GetPowerpoint
    If pptApp.CurrentPresentation = False Then pptApp.NewPresentation
    If newPres = True Then pptApp.NewPresentation

    pptApp.AddSlide tChart 

End Sub

因此，您在哪里以及如何获得所选图表是另一回事，但只要您设法从工作簿中的 ChartObject 或 Slide 中选择图表，并将其作为参数传递给上面，您应该能够根据它进行修复根据您自己的规范。

除了我的建议之外，您还可以在 MSDN 上检查您的 powerpoint 版本的 VBA 引用。