当我想要所有人时，VBA只抓住一张图表来进行ppt？

Question

我是一名业余编码员。我正在尝试将一些东西放在一起，将excel文件中的所有图表传输到powerpoint上的不同幻灯片。我已经在线测试了几个模块（一些也来自这里）。到目前为止，我发现下面这个对我来说是最全面的。我在工作表上有3个图表，由于某些原因我无法弄清楚，代码只复制一个图表（首次创建），制作新幻灯片并将其粘贴在第二张幻灯片上。不知道发生了什么，任何帮助将不胜感激：

Sub ChartsAndTitlesToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
    With ActiveSheet.ChartObjects(iCht).Chart
        
        ' get chart title
        If .HasTitle Then
            sTitle = .ChartTitle.Text
        Else
            sTitle = ""
        End If
        
        ' remove title (or it will be redundant)
        .HasTitle = False
        
        ' copy chart as a picture
        .CopyPicture _
            Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        
        ' restore title
        If Len(sTitle) > 0 Then
            .HasTitle = True
            .ChartTitle.Text = sTitle
        End If
    End With
    
    ' Add a new slide and paste in the chart
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
    PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
    With PPSlide
        ' paste and select the chart picture
        .Shapes.Paste.Select
        ' align the chart
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        .Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
    End With

Next

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub