Question

我希望将Excel 2010中的选定图表复制并粘贴到Powerpoint 2010，将Microsoft Excel图表对象格式化为活动 PPT幻灯片。理想情况下，我希望能够将这些图表放置在有效Powerpoint幻灯片上的特定位置。我已经浏览了网页，但所有（如果不是大多数）解决方案都适用于将工作表中的所有幻灯片随机粘贴到PPT幻灯片上。我甚至没有代码，但如果有人可以提供帮助，那就太棒了。谢谢！

Answer 1

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

在课堂模块中：

'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

在我的＆＃34;工厂＆＃34;模块。常规代码模块：

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中选择图表或在工作簿中滑动，并将其作为参数传递给上述，您应该能够根据你自己的规格修复它。

除了我的建议之外，还要检查MSDN上的powerpoint版本的VBA参考。

Answer 2

所以这是一个适合我的解决方案。宏复制+将选定范围或图表粘贴到活动PowerPoint幻灯片中的某个位置。我想这样做的原因是每个季度/月我们都会为客户生成报告，这有助于减少复制+粘贴所需的时间并使甲板看起来更好。希望这可以帮助其他任何制作大量PPT的人！

fs.writeFile ('/path/to/dir/file.dat'....

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

2 个答案: