Search code examples
excelvbaruntime-errorpowerpoint

Error when pasting slide: The specified data type is unavailable


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

PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse

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

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.).

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

Solution

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

    enter image description here

    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

    enter image description here