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)
Further to my comments above, this works for me. Let's say your sheet1
looks like this
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