Sending Charts to Power Point.

[Aussiebear]

The following code sends a chart to a new instance of Powerpoint. How can it be modified to send to an existing presentation?

Sub ExportChartsToPowerPoint()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim chartObj As ChartObject
    Dim slideIndex As Integer
    ' Create a new instance of PowerPoint application
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True ' Make PowerPoint visible
    ' Create a new presentation
    Set pptPres = pptApp.Presentations.Add
    slideIndex = 1 ' Initialize slide index
    ' Loop through each chart object in the worksheet
    For Each chartObj In Sheets("Slide 11").ChartObjects
        With chartObj.Chart
            ' Copy the chart
            .ChartArea.Copy
            ' Paste the chart into PowerPoint
            pptPres.Slides.Add slideIndex, 1 ' Add a new slide
            pptPres.Slides(slideIndex).Shapes.PasteSpecial
            ' Adjust the position and size of the pasted chart
            With pptPres.Slides(slideIndex).Shapes(1)
                .Left = 100 ' Adjust the left position as needed
                .Top = 100 ' Adjust the top position as needed
                .Width = 400 ' Adjust the width as needed
                .Height = 300 ' Adjust the height as needed
            End With
            slideIndex = slideIndex + 1 ' Increment slide index
        End With
    Next chartObj
    ' Clean up
    Set pptPres = Nothing
    Set pptApp = Nothing 
End Sub

Actually, on second thoughts, how could it be modified to send a selected chart to a selected powerpoint presentation?

[georgiboy]

There are going to be other methods but the below works for me, it will open a specific pptx file, add a slide, paste the selected/ active chart to that slide.

You may need to either edit the binding or add a reference to the PowerPoint object library in the VBE.

Sub ExportChartsToPowerPoint()
    Dim strPresPath As String
    Dim ppApp As PowerPoint.Application
    Dim myPres As PowerPoint.Presentation
    Dim sc As Integer
    
    strPresPath = "C:\Users\jbloggs\Desktop\test.pptx"
    
    Set ppApp = CreateObject("PowerPoint.Application")
    Set myPres = ppApp.Presentations.Open(strPresPath)
    sc = myPres.Slides.Count + 1
    
    With ActiveChart
        .ChartArea.Copy
        myPres.Slides.AddSlide sc, myPres.SlideMaster.CustomLayouts.Item(7)
        myPres.Slides(sc).Select
        ppApp.ActiveWindow.View.Paste
        With myPres.Slides(sc).Shapes(1)
            .Left = 100 ' Adjust the left position as needed
            .Top = 100 ' Adjust the top position as needed
            .Width = 400 ' Adjust the width as needed
            .Height = 300 ' Adjust the height as needed
        End With
    End With
End Sub

[snb]

Use

With getobject("G:\OF\example.pptx")

end with

Avoid 'Select' & 'Activate' & redundant Object Variables in VBA.

[georgiboy]

@snb

I have not requested any help.

If you want to help, why not suggest some code for the OP?

[german12]

I had exactly the same question after i tried the solution it worked out for me.

[Ian Crawford]

Sorry for hacking into this thread, but rather than have a set path to a defined file. Would it be possible to make this code more generalised, so I could maybe open a select file within a folder. Currently I am developing a number of presentations for groups of school children and would like to be able to push a chart into a selection of files as and when I think the need arises?

The main folder would reside in C: Users/Ian/Maths/ and then Lessons1 to how ever many. If this makes sence.

[snb]

Sub M_snb()
   ActiveSheet.ChartObjects(1).Copy
   
   With Application.FileDialog(3)
    .InitialFileName = "G:\powerpoint\*.ppt"
    .AllowMultiSelect = True
    If .Show Then
       For j = 1 To .SelectedItems.Count
        With GetObject(.SelectedItems(j))
          .slides(1).Shapes.PasteSpecial 1, , , , 1
          .Application.Visible = True
          .Close
        End With
       Next
    End If
   End With
End Sub

[Ian Crawford]

If thats for me snb then thank you.