Laufzeitfehler 2147188160 (80048240)
23.01.2015 13:04:09
Patrick
langsam verzweifle ich. Ich habe vor einigen Wochen einen vba Code geschrieben, der bis letzte Woche noch einwandfrei funktionier hat. Seit letzten Freitag tut er das nicht mehr, obwohl definitiv nichts am Code geändert wurde.
Die Fehlermeldung lautet:
Laufzeitfehler 2147188160 (80048240)
View (unknown member): Invalid request: The specified data type is unavailable
Der Fehler tritt immer auf wenn folgender Befehl versucht wird auszuführen:
pptPresentation.Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject
ich kann mir das wirklich nicht erklären... Hier nochmal der gesamte Code:
Option Explicit
Sub exportExc2PP()
'############################################################################################### _
'version: 1.0
'author: Patrick Tepass
'date: 11/17/2014
'changes that needs to be done: - User Interaction for folder path
' - create manual: How to use this program
' - close all excel and PP
'############################################################################################### _
'INPUT PARAMETER
'folder with Excel Sheets from database
Dim pathExcFold As String
pathExcFold = "H:\ExcExports"
'folder with PowerPoint Template in .pptx
Dim pathPP As String
pathPP = "H:\Export"
'############################################################################################### _
'variables
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String
Dim i As Integer
i = 0
'create full path of PowerPoint Template
pathPP = pathPP & "\" & "Presentation_Template.pptx"
'Count files in folder
Dim fso As Object
Dim numb As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
numb = fso.GetFolder(pathExcFold).Files.Count
Set fso = Nothing
Dim T() As String
ReDim Preserve T(1 To numb)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim j As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("H:\VA_VE\Projects\All_VM_Europe\Database\Export\ExcExports")
j = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file path
' Cells(i + 1, 2) = objFile.Path
T(j) = objFile.Path
j = j + 1
Next objFile
'open TRW template and set to active presentation
Dim pptApp As PowerPoint.Application
Dim pptSlide As PowerPoint.Slide
Dim pptPresentation As PowerPoint.Presentation
Set pptApp = Nothing
Set pptApp = CreateObject("PowerPoint.Application")
With pptApp
.Visible = True
.WindowState = ppWindowMaximized
.Activate
If pathPP "" Then
.Presentations.Open Filename:=pathPP, ReadOnly:=msoFalse
Else
.Presentations.Add
End If
Set pptPresentation = .ActivePresentation
End With
'start loop 2 #############################################
Dim k As Integer
Dim newFilename As String
For k = 1 To numb
Workbooks.Open T(k)
Range("B5:F39").Select
Selection.Copy
'create new slides, paste content and determine size & postition
Set pptSlide = pptPresentation.Slides.AddSlide(pptPresentation.Slides.Count + 1, _
pptPresentation.SlideMaster.CustomLayouts(2))
pptSlide.Select
pptPresentation.Application.ActiveWindow.View.PasteSpecial DataType:= _
ppPasteOLEObject
With pptPresentation.Application.ActiveWindow.Selection.ShapeRange
.Left = 25
.Top = 80
.Width = 1000
.Height = 420
End With
'set title
Dim titleStr As String
titleStr = Range("B1").Value
pptSlide.Shapes(3).TextFrame.TextRange.Text = titleStr
'clear clipboard and close workbook
Application.CutCopyMode = False
ActiveWorkbook.Close False
Next k
'end loop 2 #############################################
End Sub