VBA只有当我想要所有的时候抓住一个图表才能得到PPT？

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

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