Excel VBA Code Question - Exports charts from Excel to Power Point automatically in new slides

[dacolmani]

Hello guys,

I need to exports charts from an excel sheet to powerpoint automatically and each chart has to be in a separate slide. I have gotten some codes online but i cant get them to work.

I get error messages. Can anyone point me in the right direction? -----This is the message i get : Compile error: method or data member not found...helppp please


Sub ExportCharttoPP()


'Declare the needed variables
Dim newPP As PowerPoint.Application
Dim currentSlide As PowerPoint.Slide
Dim Xchart As Excel.ChartObject


'Check if PowerPoint is active
On Error Resume Next
Set newPP = GetObject(, "PowerPoint.Application")
On Error GoTo 0


'Open PowerPoint if not active
If newPP Is Nothing Then
Set newPP = New PowerPoint.Application
End If


'Create new presentation in PowerPoint
If newPP.Presentations.Count = 0 Then
newPP.Presentations.Add
End If


'Display the PowerPoint presentation
newPowerPoint.Visible = True


'Locate Excel charts to paste into the new PowerPoint presentation


For Each Xchart In ActiveSheet.ChartObjects


'Add a new slide in PowerPoint for each Excel chart


newPP.ActivePresentation.SlidesAdd
newPP.ActivePresentation.Slides.Count 1, ppLayoutText
newPP.ActiveWindow.View.GotoSlide
newPP.ActivePresentation.Slides.Count


Set currentSlide = newPP.ActivePresentation.Slides(newPP.ActivePresentation.Slides.Count)


'Copy each Excel chart and paste it into PowerPoint as an Metafile image
Xchart.Select
ActiveChart.ChartArea.Copy
currentSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select




'Copy and paste chart title as the slide title in PowerPoint
currentSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text


'Adjust the slide position for each chart slide in PowerPoint. Note that you can adjust the values to position the chart on the slide to your liking


newPP.ActiveWindow.Selection.ShapeRange.Left = 25
newPP.ActiveWindow.Selection.ShapeRange.Top = 150
currentSlide.Shapes(2).Width = 250
currentSlide.Shapes(2).Left = 500


Next AppActivate("Microsoft PowerPoint")
Set currentSlide = Nothing
Set newPP = Nothing




End Sub

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

I have re-written your code slightly, but I think this works.
You might need to change the top, left, height and width values.

Sub ExportCharttoPP()
    'Declare the needed variables
    Dim newPP           As PowerPoint.Application
    Dim newPres         As PowerPoint.Presentation
    Dim XLchart         As Excel.ChartObject
 
    'Check if PowerPoint is active
    On Error Resume Next
    Set newPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
 
    'Open PowerPoint if not active
    If newPP Is Nothing Then Set newPP = New PowerPoint.Application
     
    'Display the PowerPoint presentation
    newPP.Visible = True
     
    'Create new presentation in PowerPoint
    If newPP.Presentations.Count = 0 Then
        Set newPres = newPP.Presentations.Add
    Else
        Set newPres = newPP.Presentations(newPP.Presentations.Count)
    End If
 
 
 
    'Locate Excel charts to paste into the new PowerPoint presentation
    For Each XLchart In ActiveSheet.ChartObjects
        'Add a new slide in PowerPoint for each Excel chart
        With newPres.Slides.Add(Index:=newPres.Slides.Count + 1, Layout:=ppLayoutCustom)
    
            'Copy each Excel chart and paste it into PowerPoint as an Metafile image
            XLchart.Chart.ChartArea.Copy
            
            'currentSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
            .Shapes.Paste
        
            'Copy and paste chart title as the slide title in PowerPoint
            .Shapes(1).TextFrame.TextRange.Text = XLchart.Chart.ChartTitle.Text
            
            'Adjust the slide position for each chart slide in PowerPoint. Note that you can adjust the values to position the chart on the slide to your liking
            .Shapes(2).Top = 150
            .Shapes(2).Left = 25
            .Shapes(2).Width = 250
            .Shapes(2).Height = 150
        End With
    Next
    
    newPP.Activate
    Set newPP = Nothing
 
End Sub

Regards,

 

[dacolmani]

thank you so much!!! i made some adjustments and it worked

 

[RickXL]

Good news.

Thanks for letting me know.


Regards,