VBA: Копировать + Вставить выбранные карты из Excel в PowerPoint

Question

Я ищу, чтобы скопировать и вставить выбранные карты из Excel 2010 для PowerPoint 2010 в формате диаграммы объектов Microsoft Excel в активный РРТ слайде. В идеале я хотел бы разместить эти диаграммы в определенных положениях на активном слайде Powerpoint. Я искал веб-страницы, но все, если не большинство решений, предназначены для всех слайдов на листе, которые будут случайно наклеены на слайде PPT. У меня даже нет кода, но если кто-то может помочь, это будет потрясающе. Благодаря!

Answer 1

Итак, вот решение, которое сработало для меня. Макро копия + пасты выбрано диапазон или график в активный слайд PowerPoint в определенное положение. Эта причина, по которой я хотел сделать это, состоит в том, что каждый квартал/месяц мы создаем отчеты для наших клиентов, и это помогает сократить время, необходимое для копирования + вставки и создания палубы. Надеюсь, это поможет кому угодно, кто сделает тонну PPT!

'Export and position into Active Powerpoint 

'Prior to running macro, enable Microsoft Powerpoint Object Library in Tools - Reference 

'Identifies selection as either range or chart 
Sub ButtonToPresentation() 

If TypeName(Selection) = "Range" Then 
    Call RangeToPresentation 
Else 
    Call ChartToPresentation 
End If 

End Sub 

Sub RangeToPresentation() 

Dim PPApp As PowerPoint.Application 
Dim PPPres As PowerPoint.Presentation 
Dim PPSlide As PowerPoint.Slide 

'Error message if range is not selected 
If Not TypeName(Selection) = "Range" Then 
    MsgBox "Please select a worksheet range and try again." 
Else 
    'Reference existing instance of PowerPoint 
    Set PPApp = GetObject(, "Powerpoint.Application") 
    'Reference active presentation 
    Set PPPres = PPApp.ActivePresentation 
    'Reference active slide 
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) 

    'Copy the range as a picture 
    Selection.CopyPicture Appearance:=xlScreen, _ 
    Format:=xlBitmap 
    'Paste the range 
    PPSlide.Shapes.Paste.Select 

    'Align the pasted range 
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 

    ' Clean up 
    Set PPSlide = Nothing 
    Set PPPres = Nothing 
    Set PPApp = Nothing 
End If 

End Sub 

Sub ChartToPresentation() 
'Uses Late Binding to the PowerPoint Object Model 
'No reference required to PowerPoint Object Library 

Dim PPApp As Object 'As PowerPoint.Application 
Dim PPPres As Object 'As PowerPoint.Presentation 
Dim PPSlide As Object 'As PowerPoint.Slide 

'Error message if chart is not selected 
If ActiveChart Is Nothing Then 
    MsgBox "Please select a chart and try again." 
Else 
    'Reference existing instance of PowerPoint 
    Set PPApp = GetObject(, "Powerpoint.Application") 
    'Reference active presentation 
    Set PPPres = PPApp.ActivePresentation 
    'PPApp.ActiveWindow.ViewType = 1 ' 1 = ppViewSlide 
    'Reference active slide 
    Set PPSlide = PPPres.Slides _ 
     (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) 

    'Copy chart as a picture 
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _ 
     Format:=xlPicture 
    'Paste chart 
    PPSlide.Shapes.Paste.Select 

    'Align pasted chart 
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 

    ' Clean up 
    Set PPSlide = Nothing 
    Set PPPres = Nothing 
    Set PPApp = Nothing 
End If 

End Sub 

Answer 2

Ну, вот что-то: Это класс 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 или Слайд в вашей книге и передайте его как параметр выше, вы должны быть исправлены, чтобы исправить его в соответствии с вашими спецификациями.

За исключением рекомендаций, я хотел бы проверить ссылку на VBA для версии PowerPoint в MSDN.