VBA - Export excel charts to power point on same slide - vba

Question

Sub Export_Allcahrts_ppt()
Dim mypowerpoint As PowerPoint.Application
Set mypowerpoint = New PowerPoint.Application
mypowerpoint.Visible = msoTrue
Dim mypowerpoint_pres As PowerPoint.Presentation
Set mypowerpoint_pres = mypowerpoint.Presentations.Add
Dim myslide As PowerPoint.Slide
Set myslide = mypowerpoint_pres.Slides.Add(1, ppLayoutBlank)
Dim mychart As ChartObject
Dim j As Long
j = 0
For Each mychart In Sheet1.ChartObjects
j = j + 1
Next
For Each mychart In Sheet1.ChartObjects
mychart.Copy
myslide.Shapes.PasteSpecial ppPasteBitmap
myslide.Shapes(1).Top = 100
myslide.Shapes(1).Height = 200
myslide.Shapes(1).Left = 30
If mypowerpoint_pres.Slides.Count < j Then
Set myslide = mypowerpoint_pres.Slides.Add(mypowerpoint_pres.Slides.Count + 1, ppLayoutBlank)
Else
Exit Sub
End If
Next
End Sub

Answer 1

First, you don't need to loop to get j; just use
j = Sheet1.ChartObjects.Count
But you also don't need j at all. What your code does is insert a new slide for each new chart if the number of slides does not yet equal the number of charts copied so far.
So try this slightly rearranged and streamlined code. I haven't tested it, but I don't think I've changed the syntax.
Sub Export_Allcahrts_ppt()
Dim mypowerpoint As PowerPoint.Application
Dim mypowerpoint_pres As PowerPoint.Presentation
Dim myslide As PowerPoint.Slide
Dim mychart As ChartObject
Dim j As Long
Set mypowerpoint = New PowerPoint.Application
mypowerpoint.Visible = msoTrue
Set mypowerpoint_pres = mypowerpoint.Presentations.Add
Set myslide = mypowerpoint_pres.Slides.Add(1, ppLayoutBlank)
j = Sheet1.ChartObjects.Count
For Each mychart In Sheet1.ChartObjects
mychart.Copy
myslide.Shapes.PasteSpecial ppPasteBitmap
With myslide.Shapes(myslide.Shapes.Count)
.Top = 100
.Height = 200
.Left = 30
End With
Next
End Sub