VBA错误438-尝试将Excel图表复制到现有Ppt演示文稿

我正在尝试使用VBA将图表从Excel复制到现有的Powerpoint模板。此代码返回错误438-对象不支持此属性或方法：

'Create a new Powerpoint session
    Set pptApp = CreateObject("PowerPoint.Application")
    '
    pptApp.Visible = msoTrue
    'Create a new presentation
    Set pptPres = pptApp.Presentations.Open("....potx")
    Set pptPres = pptApp.ActivePresentation
    '
    pptApp.ActiveWindow.ViewType = ppViewSlide
'
    Current_slide = pptPres.Slides.FindBySlideID(258)
    For Each ws In ActiveWorkbook.Worksheets
      'Verify if there is a chart object to transfer
      If ws.ChartObjects.Count > 0 Then
        For Each objChartObject In ws.ChartObjects
          Set objChart = objChartObject.Chart
          'ppLayoutBlank = 12
          Set pptSld = pptPres.Slides.FindBySlideID(Current_slide)
          pptApp.ActiveWindow.View.GotoSlide (pptSld)
          With objChart
           'Copy chart object as picture
            objChart.CopyPicture xlScreen, xlBitmap, xlScreen
            'Paste copied chart picture into new slide
            pptSld.Shapes.Paste.Select
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
          End With
          Current_slide = Current_slide + 1
        Next objChartObject
      End If
    Next ws

---

在模块顶部添加以下内容：

选项显式

然后尝试这些更改（主要是aircode，但这只是一个开始）：

---

哪一行有错误？您可以通过使用调试器单步执行代码来发现这一点。我在这里看到了很多错误。您可以发布顶部带有声明的完整代码吗？您可以去掉

Set pptPres=pptap.ActivePresentation

，因为您已经在前一行中设置了该变量。如果ws.ChartObjects.Count>0，则可以去掉此

，因为每个objChartObject的
循环将处理此问题。否则，正如其他人所指出的，请告诉我们错误发生在哪里，并发布完整的代码。
Dim Current_slide as Long
Dim pptSlide as PowerPoint.Slide
Dim oShRange as PowerPoint.ShapeRange

' I don't know why exactly you're using FindBySildeID
' Care to explain that?
Current_slide = pptPres.Slides.FindBySlideID(258).SlideIndex

    For Each ws In ActiveWorkbook.Worksheets
      'Verify if there is a chart object to transfer

' Don't really need this; if count is 0, the code within the
' For Each loop won't execute:
'      If ws.ChartObjects.Count > 0 Then
        For Each objChartObject In ws.ChartObjects
          Set objChart = objChartObject.Chart
          'ppLayoutBlank = 12
'         This needs a LONG not an object, so 
          Set pptSld = pptPres.Slides.FindBySlideID(Current_slide)

' You don't really need to GoTo the slide in order to operate on it          
' Doing so will slow things down; if you want to see it work, though, 
' uncomment:
'         pptApp.ActiveWindow.View.GotoSlide (pptSld)

          With objChart
           'Copy chart object as picture
            objChart.CopyPicture xlScreen, xlBitmap, xlScreen

            'Paste copied chart picture into new slide
'            pptSld.Shapes.Paste.Select
            Set oShRange = pptSld.Shapes.Paste
            With oShRange
              .Align msoAlignCenters, True
              .Align msoAlignMiddles, True
            End With  ' oShRange

          End With  
          Current_slide = Current_slide + 1
        Next objChartObject
 '     End If
    Next ws