粘贴幻灯片时出错：指定的数据types不可用

在PowerPoint中粘贴幻灯片时，出现以下错误：

PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse 

运行时错误-2147188160（80048240）：查看（未知成员）：请求无效。 指定的数据types是不可用的

我已经多次运行这个代码，之前运行正常。

另外，一旦对象/图表正在复制; 我正在切换到PowerPoint，看看我是否可以粘贴。 我可以粘贴所有的选项（如图片，作为embedded式图像等）。

这是完整的代码，直到我得到错误，因为它不是在评论部分

这是代码：直到我得到错误的行

  Sub export_to_ppt() Set objExcel = CreateObject("Excel.Application") 'Keep the Importing master sheet address here: Set objWorkbook = objExcel.Workbooks.Open("d:\Documents and Settings \Export to ppt.xlsm") 'Keep all the worksheets which you want to import from here: Path = "D:\Office Documents\2013\ Latest Xcel\" Filename = Dir(Path & "*.xlsm") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True Dim sht As Workbooks Set Sheet = Workbooks(Filename).Sheets("Issues Concern") Sheet.Copy After:=ThisWorkbook.Sheets(1) Set Sheet = Workbooks(Filename).Sheets("Key Initiatives Update") Sheet.Copy After:=ThisWorkbook.Sheets(1) Set Sheet = Workbooks(Filename).Sheets("Solution Update") Sheet.Copy After:=ThisWorkbook.Sheets(1) Set Sheet = Workbooks(Filename).Sheets("Overall Practice Status") Sheet.Copy After:=ThisWorkbook.Sheets(1) Set Sheet = Workbooks(Filename).Sheets("Practice Financials") Sheet.Copy After:=ThisWorkbook.Sheets(1) Workbooks(Filename).Close Filename = Dir() Loop Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim SlideCount As Integer Dim shptbl As Table Dim oShape As PowerPoint.Shape Dim SelectRange As Range Dim SelectCell As Range Set PPApp = CreateObject("PowerPoint.Application") PPApp.Visible = msoTrue 'opening an existing presentation Filename = "D:\Office Documents\Presentation1.pptx" Set PPPres = PPApp.Presentations.Open(Filename) Dim s As String Dim i As Integer i = 2 Line3: MsgBox (ActiveSheet.Name) If ActiveSheet.Name Like ("*Solution Update*") Then GoTo Line1 ElseIf ActiveSheet.Name Like ("*Key Initatives Update*") Then GoTo Line4 ElseIf ActiveSheet.Name Like ("*Issues Concern*") Then GoTo Line13 End If Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly) PPSlide.Shapes(1).TextFrame.TextRange.Text = "Practice Financials - " & Sheets(i).Range("AH1").Value & " " 'PPSlide.Shapes(1).TextFrame.TextRange.Text = Sheets(1).Range("B1").Value 'format header With PPSlide.Shapes(1).TextFrame.TextRange.Characters .Font.Size = 24 .Font.Name = "Arial Heading" '.Font.Color = vbBlue End With Range("A1:K7").Select Selection.Copy PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex ' activate the slide no 'PPApp.Activate PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method 'PPApp.ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile 'PPApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture) 

Answer 1

除了我上面的评论，这对我有用。 假设你的sheet1看起来像这样

将此代码粘贴到模块中。

 Option Explicit Sub Sample() Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim SlideCount As Long Dim ws As Worksheet Dim rng As Range Dim Filename As String Set ws = ThisWorkbook.Sheets("Sheet1") Set rng = ws.Range("A1:K7") Set PPApp = CreateObject("PowerPoint.Application") PPApp.Visible = msoTrue 'opening an existing presentation Filename = "C:\Presentation1.pptx" Set PPPres = PPApp.Presentations.Open(Filename) SlideCount = PPPres.Slides.count Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly) With PPSlide.Shapes(1).TextFrame.TextRange .Text = "Practice Financials - " & _ ws.Range("AH1").Value & " " With .Characters.Font .Size = 24 .Name = "Arial Heading" End With End With rng.Copy DoEvents PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse End Sub 

OUTPUT

Answer 2

我有同样的问题，它发生了，因为我试图从Excel导出到PowerPoint没有PowerPoint引用，使用它作为对象。 棘手的是有时候它有效，有时候它不会。 因此，经过一些testing，我发现它取决于PowerPoint视图的状态，如果它显示缩略图或正常的幻灯片视图。

要解决这个问题，在粘贴之前将ViewType设置为正常。

 PPAP.ActiveWindow.ViewType = ppViewNormal 

要么

 PPAP.ActiveWindow.ViewType = 9 

PPAP代表Power Point应用程序对象。