Excel VBA,添加新幻灯片到PPT时出现错误438

我试图在已打开的excel文件中的每个图表的现有PowerPoint演示文稿中添加silde。 VBA不断抛出错误。 在这里pptApp.ActivePresentation.Add我不断收到一个错误,该对象不支持方法并在这里ActiveChart.ChartArea.Copy该对象variables没有设置。

是如同绝望吗?

Option Explicit #Const EARLYBINDING = False Sub CopyAndLinkAllChartsToExistingPPT() #If EARLYBINDING Then Dim pptApp As PowerPoint.Application Dim pptPres As PowerPoint.Presentation Dim pptSlide As PowerPoint.Slide #Else Dim pptApp As Object Dim pptPres As Object Dim pptSlide As Object Const ppLayoutTitle = 1 #End If Dim workS As Worksheet Dim chartS As Excel.ChartObjects Dim workS_Count As Integer Dim chartS_Count As Integer Dim W As Integer Dim C As Integer 'Declaring PPT objects Set pptApp = GetObject(, "PowerPoint.Application") Set pptPres = pptApp.Presentations.Add(msoTrue) Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitle) 'Declaring Excel objects Set workS = ActiveWorkbook.worksheets(1) Set chartS = workS.ChartObjects 'Amount of worksheets and charts for the loops workS_Count = ActiveWorkbook.worksheets.Count chartS_Count = workS.ChartObjects.Count 'Nested loop for all the worksheets and charts For W = 1 To workS_Count For C = 1 To chartS_Count pptApp.ActivePresentation.Add pptApp.ActivePresentation.Slides.Count 1, ppLayoutTitle pptApp.ActiveWindow.View.GotoSlide pptApp.ActivePresentation.Slides.Count Set pptSlide = pptApp.ActivePresentation.Slides(pptApp.ActivePresentation.Slides.Count) chartS.Select ActiveChart.ChartArea.Copy 'Pasting chart in PowerPoint slide with a data link pptSlide.Shapes.PasteSpecial link:=msoTrue Next C Next W ' Clearing the objects Set pptApp = Nothing Set pptPres = Nothing Set pptSlide = Nothing Set workS = Nothing Set chartS = Nothing End Sub 

我认为当你添加幻灯片的时候,你会发现错误。 你已经创build了一个演示文稿,所以你只需要添加幻灯片和粘贴图表? 你在循环中做什么(和错误的)是为每个需要粘贴的图表添加一个新的演示文稿,然后为它添加幻灯片。

试着简化它:

 For W = 1 To workS_Count For C = 1 To chartS_Count Set pptSlide = pptPres.slides.add(pptPres.slides.count, ppLayoutTitle) chartS(chartS_Count).Select ActiveChart.ChartArea.Copy 'Pasting chart in PowerPoint slide with a data link pptSlide.Shapes.PasteSpecial link:=msoTrue Next C Next W