Vba 运行时错误1004';应用程序定义或对象定义错误';将使用范围的工作表粘贴到powerpoint幻灯片时
我有一个Excel工作表,可以将模板工作表复制到新工作表中。在前两次迭代中,它运行并将使用的范围粘贴到Powerpoint的特定幻灯片中,但在第三次迭代中,它在这行代码中抛出以下错误 运行时错误1004应用程序定义或对象定义错误Vba 运行时错误1004';应用程序定义或对象定义错误';将使用范围的工作表粘贴到powerpoint幻灯片时,vba,excel,ms-office,powerpoint,Vba,Excel,Ms Office,Powerpoint,我有一个Excel工作表,可以将模板工作表复制到新工作表中。在前两次迭代中,它运行并将使用的范围粘贴到Powerpoint的特定幻灯片中,但在第三次迭代中,它在这行代码中抛出以下错误 运行时错误1004应用程序定义或对象定义错误 PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile Set myshape = PPslide.Shapes(PPslide.Shapes.Count) 我的代码: Private
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
非常感谢您的帮助
提前谢谢你
工作表(WS.Name)
-为什么不仅仅是WS?!感谢jivko的回复。。我尝试在代码中使用相同的方法来拆分工作表中的内容,现在,我在以下代码行中遇到类型不匹配错误::'ElseIf k(TotalSheetsReqd-1)或tmpvar 1 Then Sheets(WS)。激活工作表(WS)。范围(单元格(sfirstrowSheet,1),单元格(sLastRowOfSheet,LastCol)).Copy“将手表添加到正在比较的变量中以查看值,您将发现类型不匹配的原因。
**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