Hi everyone, I am looking for help with my macro that I wrote recently.
Its fairly simple, though I still have some problems with it to work correctly.
It should copy charts (to be precise define rages found by their name) from excel file and paste them to PPT presentation first creating new slide, and then pasting the chart.
It seems I have problem with the loop and with pasting the chart… It always goes to the last slide.
Another question would be how to paste for example 4 charts on one slide? and place them as I want.



Sub Export_PPT_E()
Dim ppApp As Object
Dim Name As Name
Dim powerpointApp As Object
Dim Slidecount As Long
Dim PPSlide As PowerPoint.Slide
Dim ChartName As String
Dim x As Integer
WB_Name = ActiveWorkbook.Name
WS_Name = ActiveSheet.Name
Application.Calculation = xlCalculationAutomatic
Set powerpointApp = CreateObject("Powerpoint.Application")
With powerpointApp
.Visible = True
.Presentations.Open Filename:="C:\Users\xxx\xxxx.pptx"
End With
x = 1

''-----------------------------------------------------------------------------------

Select Case x
Case 1
ChartName = "Chart1"
Case 2
ChartName = "Chart2"
Case 3
ChartName = "Chart3"
Case 4
ChartName = "Chart4"
Case 5
ChartName = "Chart5"
Case 6
ChartName = "Chart6"
Case 7
ChartName = "Chart7"
Case 8
ChartName = "Chart8"
Case 9
ChartName = "Chart9"
Case 10
ChartName = "Chart10"
Case 11
ChartName = "Chart11"
End Select

Do Until x = 11

'ChartName = ActiveWorkbook.Names("Chart1").Name
Application.Goto Reference:=ActiveWorkbook.Names(ChartName).Name
With Workbooks(WB_Name).Worksheets(WS_Name)
.Range(ChartName).Select
.Range(ChartName).Copy
End With

With powerpointApp
.Visible = True
Slidecount = powerpointApp.ActivePresentation.Slides.Count
If x > 1 Then Set PPSlide = powerpointApp.ActivePresentation.Slides.Add(Slidecount, ppLayoutBlank)
If Slidecount = 1 Then .ActivePresentation.Slides(.ActivePresentation.Slides().Count).Select Else .ActivePresentation.Slides(.ActivePresentation.Slides().Count - 1).Select
End With

With powerpointApp.ActiveWindow 'ActivePresentation.Slides(x)

.View.PasteSpecial DataType:=ppPasteEnhancedMetafile 'ppPasteOLEObject 'DataType:=ppPasteJPG
.Selection.ShapeRange.Left = 70.6
.Selection.ShapeRange.Top = 65.45
.Selection.ShapeRange.Width = 450
.Selection.ShapeRange.Height = 430
End With

x = x + 1
Loop
End Sub