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

Question

我正在尝试使用 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

Answer 1

在模块顶部添加：

选项显式

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

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