Witam, chcę napisać makro które będzie przeklejało wykresy z Excela do prezentacji PPT (jako obraz).
Niestety nie działa tak jak bym chciał. Mam problem z pętlą oraz z tym żeby każdy kolejny wykres nie jest wklejany do nowego slajdu, tylko zawsze do tego samego. Prośba o wskazanie błędów w moim kodzie:

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