Question

我试图在打开的Excel文件中为每个图表添加现有powerpoint演示文稿中的silde。 VBA不断抛出错误。在这里pptApp.ActivePresentation.Add我不断收到Object不支持方法的错误并且在这里ActiveChart.ChartArea.Copy没有设置对象变量。

是否像看上去一样毫无希望？

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

Answer 1

我认为当你添加幻灯片时，你完全错了。您已经创建了演示文稿，因此您只需要添加幻灯片并粘贴图表吗？您在循环中所做的事情（以及错误的）是为每个需要粘贴的图表添加新的演示文稿，然后添加幻灯片。

尝试简化它：

result <- (NumToken 42) :: result

Excel VBA，向PPT添加新幻灯片时出现错误438

1 个答案: