Excel Ausschnitt in Powerpoint einfügen
22.08.2017 10:38:28
ZD14
Ich habe eine Frage zum untenstehenden Code! Ich würde gerne verschiedene Bereiche einer Excel Arbeitsmappe in eine PowerPoint-Präsentation kopieren. Das ganze klappt, wenn ich den Bereich auswähle, kopiere und dann die Präsentation öffne. Allerdings kann ich dann keine Schleife mehr bauen. Also öffne ich zuerst PowerPoint, danach passiert aber gar nichts mehr! Nicht mal die Messagebox wird angezeigt. Ich vermute, ich muss Excel wieder aktivieren, ansprechen bzw. PowerPoint deaktivieren oder so ähnlich.
Bin für jeden Hinweis sehr dankbar! :)
LG ZD14
Sub PowerpointQ2Export()
Dim oPPT As Object
Dim i As Integer
Dim j As Integer
Application.ScreenUpdating = True
'Präsentation erstellen
Set oPPT = CreateObject("Powerpoint.Application")
With oPPT
.Visible = True
.Presentations.Open Filename:="C:\Users\m000aaug\Desktop\Makros\Master.pptx"
End With
For j = 1 To j = 4
MsgBox j
'Bereich bestimmen, neue Bereiche hinzufügen --> j erhöhen & Präsentationsmaster _
anpassen
If j = 1 Then ActiveWorkbook.Sheets("PM-DB").Range("C15:X55").Select
If j = 2 Then ActiveWorkbook.Sheets("PBU").Range("F67:Y136").Select
If j = 3 Then ActiveWorkbook.Sheets("FPR").Range("C4:AA38").Select
If j = 4 Then ActiveWorkbook.Sheets("PM-DB").Range("C47:AE81").Select
ActiveWorkbook.Selection.Copy
oPPT.ActivePresentation.Slides(j).Select
i = oPPT.ActivePresentation.Slides(j).Shapes.Count 'Anzahl der Bereiche auf der Folie -- _
_
> verhindert das Löschen vom Titel
If i > 1 Then
oPPT.ActivePresentation.Slides(j).Shapes(i).Delete
oPPT.ActivePresentation.Slides(j).Shapes.PasteSpecial(DataType:=xlBitmap).Select
With oPPT.ActivePresentation.Slides(j).Shapes(i)
.Height = 290
.Width = 900
.Left = 29
.Top = 145
End With
Else
oPPT.ActivePresentation.Slides(j).Shapes.PasteSpecial(DataType:=xlBitmap).Select
With oPPT.ActivePresentation.Slides(j).Shapes(2)
.Height = 290
.Width = 900
.Left = 29
.Top = 145
End With
End If
Next j
ActivePresentation.SaveAs "Financials_Q2_" & Range("A1") & Format(Date, YYYYMMDD) & ".pptx" _
_
'Customer, ProdType und ProjectDetails einfügen!
.SaveAs "Old Format Copy"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub