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

Error when pasting slide: The specified data type is unavailable

提问by Myra

I am getting following error while pasting a slide in PowerPoint in the following line:

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

PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse

Run-time error -2147188160 (80048240):View (unknown member) : Invalid request. The specified data type is Unavailable

运行时错误 -2147188160 (80048240):View (unknown member): 无效请求。指定的数据类型不可用

I have run this code multiple times and it was running fine before.

我已经多次运行此代码，并且之前运行良好。

Also, once the object/chart is copying; I am switching to PowerPoint to see if I can paste. I can paste with all the options (As picture, As Embedded Image, etc.).

此外，一旦对象/图表正在复制；我正在切换到 PowerPoint 以查看是否可以粘贴。我可以粘贴所有选项（作为图片、作为嵌入图像等）。

Here is the full code till I am getting error as it was not coming in comment section

这是完整的代码，直到我收到错误，因为它没有出现在评论部分

Here is the code : Till the line where I get error

这是代码：直到出现错误的那一行

 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 Documents13\ 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) 

采纳答案by Siddharth Rout

Further to my comments above, this works for me. Let's say your sheet1looks like this

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

Paste this code in a module.

将此代码粘贴到模块中。

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

输出

回答by ChrCury78

I was having the same problem and it happened as I was trying to export from Excel to PowerPoint without the PowerPoint reference, using it as object. The tricky thing was that sometimes it worked, other times it won′t. So after some testing I found out that it depends on the state of the PowerPoint View, if it is showing Thumbnails or a normal Slide view.

我遇到了同样的问题，当我试图在没有 PowerPoint 引用的情况下从 Excel 导出到 PowerPoint 并将其用作对象时发生了这种情况。棘手的是，有时它会起作用，有时则不会。因此，经过一些测试，我发现它取决于 PowerPoint 视图的状态，是显示缩略图还是正常的幻灯片视图。

To fix it, set the ViewType as normal before pasting.

要修复它，请在粘贴之前将 ViewType 设置为正常。

PPAP.ActiveWindow.ViewType = ppViewNormal

or

或者

PPAP.ActiveWindow.ViewType = 9

PPAPstands for power point application object.

PPAP代表电源点应用程序对象。