从Excel工作表复制到特定的Powerpoint幻灯片

我正在使用EXcel VBA将数据从excel传输到带有自动脚本的powerpoint幻灯片 . 我正在尝试复制excel工作表的usedrange并将其粘贴为第4张幻灯片的powerpoint模板中的图像，并从那里添加新幻灯片并将剩余的工作表复制到下一个其他幻灯片 . 因此，在我的第一次迭代的代码中，它是从第一张工作表的excel工作表复制并在第4张幻灯片中粘贴它，但是对于下一次迭代，它会抛出如下错误：

我正在使用的代码收到以下错误

"Run Time Error -2147188160(80048240) AutomationError".

我是Excel VBA的新手 . 请帮助任何人都可以建议我以下代码 .

希望这清楚地解释 . 如果没有，请要求更多说明 .

谢谢

Private Sub CommandButton2_Click()
  Dim PP As PowerPoint.Application
  Dim PPpres As Object
  Dim PPslide As Object
  Dim PpTextbox As PowerPoint.Shape
  Dim SlideTitle As String
  Dim SlideNum As Integer
  Dim WSrow As Long
  Dim Sh As Shape
  Dim Rng As Range
  Dim myshape As Object
  Dim myobject As Object 
  'Open PowerPoint and create new presentation
  Set PP = GetObject(class, "PowerPoint.Application")
  PP.Visible = True

  Set PPpres = PP.Presentations.Open("\\C:\Users\Templates")

 'Specify the chart to copy and copy it

  For Each WS In Worksheets
    If (WS.Name) <> "EOS" Then
        ThisWorkbook.Worksheets(WS.Name).Activate
        ThisWorkbook.ActiveSheet.UsedRange.CopyPicture
        lastrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row   
 'Copy Range from Excel
  Set Rng = ThisWorkbook.ActiveSheet.Range("A1:I" & lastrow)
'Copy Excel Range
  Rng.Copy
For k = 4 To 40
    slidecount = PPpres.Slides.Count
    PP.ActiveWindow.View.GotoSlide (k)
'Paste to PowerPoint and position
    Set PPslide = PPpres.Slides(k)
    PPslide.Shapes.PasteSpecial DataType:=10  '2 = ppPasteEnhancedMetafile
    Set myshape = PPslide.Shapes(PPslide.Shapes.Count)
    'Set position:
      myshape.Left = 38
      myshape.Top = 152
'Add the title to the slide
    SlideTitle = "Out of Support, " & WS.Name & " "
    Set PpTextbox = PPslide.Shapes.AddTextbox(msoTextOrientationHorizontal, 
    0, 20, PPpres.PageSetup.SlideWidth, 60)
    PPslide.Shapes(1).TextFrame.TextRange = SlideTitle

  'Set PPslide = PPpres.Slides.Add(slidecount + 1, ppLayoutTitle)
   'Make PowerPoint Visible and Active
    PP.Visible = True
    PP.Activate
 'Clear The Clipboard
Application.CutCopyMode = False
Next k 
    Exit For   
  End If
    Next WS
End Sub