Question

我有一个Excel工作表，可以将模板表复制到新工作表中。在前两次迭代中，它运行并将使用的范围粘贴到Powerpoint的特定幻灯片中。但在第三次迭代中，它会在这行代码中抛出以下错误。

运行时错误1004应用程序定义或对象定义错误

PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myshape = PPslide.Shapes(PPslide.Shapes.Count)

我的代码：

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
Dim trgsheet As Worksheet
Set PP = GetObject(class, "PowerPoint.Application")
PP.Visible = True
Set PPpres = PP.Presentations.Open("\\C:\Users\Templates")
m = 4
'Specify the chart to copy and copy it
For Each WS In Worksheets
If WS.Name <> "EOS" Then
ThisWorkbook.Worksheets(WS.Name).Activate
LastRow = ActiveSheet.UsedRange.Rows.Count
LastCol = ActiveSheet.UsedRange.Columns.Count
'For splitting the contents across slides, tmp worksheets are created
If LastRow > 25 Then
tmpvar = 0
sTotalRowsLastSlide = LastRow - 25 * Int(LastRow / 25)
If sTotalRowsLastSlide < 4 Then
        TotalSheetsReqd = Int(LastRow / 25)
        tmpvar = 1
    Else
        TotalSheetsReqd = Int((LastRow / 25)) + 1
  End If
For k = 0 To (TotalSheetsReqd - 1)
        sFirstRowOfSheet = (25 * k) + 1
        sLastRowOfSheet = (25 * (k + 1))
         'To add tmp worksheet
          Set trgsheet = Worksheets.Add(After:=ActiveSheet)
          trgsheet.Name = WS.Name & "tmp" & k

          'To copy column header to tmp sheet
          If k > 0 Then
          Sheets(WS.Name).Activate
          Sheets(WS.Name).Range(Cells(1, 1), Cells(1, LastCol)).Copy
          Sheets(trgsheet.Name).Activate
          Sheets(trgsheet.Name).Range("A1").Select
          ActiveSheet.Paste
          End If
          'To copy contents in 25numbers across sheets created
        If k = (TotalSheetsReqd - 1) And tmpvar = 1 Then
            Sheets(WS.Name).Activate
            Sheets(WS.Name).Range(Cells(sFirstRowOfSheet, 1), Cells(LastRow, LastCol)).Copy
            Sheets(trgsheet.Name).Activate
            Sheets(trgsheet.Name).Range("A2").Select
            ActiveSheet.Paste
        ElseIf k <> (TotalSheetsReqd - 1) Or tmpvar <> 1 Then
            Sheets(WS.Name).Activate
            Sheets(WS.Name).Range(Cells(sFirstRowOfSheet, 1), Cells(sLastRowOfSheet, LastCol)).Copy
            Sheets(trgsheet.Name).Activate
            Sheets(trgsheet.Name).Range("A2").Select
            ActiveSheet.Paste
        End If

    Next k
        Application.DisplayAlerts = False
        Sheets(WS.Name).Delete
        Application.DisplayAlerts = True
   End If
 'Copy Range from Excel
  Set Rng = ThisWorkbook.ActiveSheet.Range("A1:I" & LastRow)


'Copy Excel Range
 Rng.Copy

 For k = m To 45
 PP.ActiveWindow.View.GotoSlide (k)
 'Paste to PowerPoint and position
 Set PPslide = PPpres.Slides(k)
 PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
 Set myshape = PPslide.Shapes(PPslide.Shapes.Count)

 'Set position:
  myshape.Left = 48
  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 = True
 m = m + 1

 Exit For
 Next k



 End If

 Next WS


 End Sub

基本上是为了在幻灯片之间拆分内容，我正在创建临时工作表，这些工作表适用于前2个工作表，而第3个工作表则应该转到条件，因为该条件为真，但在此之前它将作为应用程序定义的错误抛出如上所述。

    **Code for splitting the contents in the worksheets**     


 If LastRow > 25 Then
  tmpvar = 0
  sTotalRowsLastSlide = LastRow - 25 * Int(LastRow / 25)


    If sTotalRowsLastSlide < 4 Then
        TotalSheetsReqd = Int(LastRow / 25)
        tmpvar = 1
    Else
        TotalSheetsReqd = Int((LastRow / 25)) + 1
    End If



    For k = 0 To (TotalSheetsReqd - 1)
        sFirstRowOfSheet = (25 * k) + 1
        sLastRowOfSheet = (25 * (k + 1))
         'To add tmp worksheet
          Set trgsheet = Worksheets.Add(After:=ActiveSheet)
          trgsheet.Name = WS.Name & "tmp" & k

          'To copy column header to tmp sheet
          If k > 0 Then
          Sheets(WS.Name).Activate
          Sheets(WS.Name).Range(Cells(1, 1), Cells(1, LastCol)).Copy
          Sheets(trgsheet.Name).Activate
          Sheets(trgsheet.Name).Range("A1").Select
          ActiveSheet.Paste
          End If
          'To copy contents in 25numbers across sheets created
        If k = (TotalSheetsReqd - 1) And tmpvar = 1 Then
            Sheets(WS.Name).Activate
            Sheets(WS.Name).Range(Cells(sFirstRowOfSheet, 1), Cells(LastRow, LastCol)).Copy
            Sheets(trgsheet.Name).Activate
            Sheets(trgsheet.Name).Range("A2").Select
            ActiveSheet.Paste
        ElseIf k <> (TotalSheetsReqd - 1) Or tmpvar <> 1 Then
            Sheets(WS.Name).Activate
            Sheets(WS.Name).Range(Cells(sFirstRowOfSheet, 1), Cells(sLastRowOfSheet, LastCol)).Copy
            Sheets(trgsheet.Name).Activate
            Sheets(trgsheet.Name).Range("A2").Select
            ActiveSheet.Paste
        End If

    Next k
        Application.DisplayAlerts = False
        Sheets(WS.Name).Delete
        Application.DisplayAlerts = True
   End If

当它循环通过这个条件时，它会抛出以下错误..

Object defined or application defined  Run time error-1004

任何帮助都非常感谢!!!!

提前谢谢!!!!

运行时错误1004“应用程序定义或对象定义错误”，同时将已使用的工作表范围粘贴到幻灯片幻灯片

0 个答案: