Question

我使用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

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

0 个答案: