VBA PowerPoint Mappe aktivieren

Sub ExporttoPPT()
'1. Variablen deklarieren
Dim ppt_app As New PowerPoint.Application
Dim pre As PowerPoint.Presentation
Dim slde As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim wb As Workbook
Dim rng As Range
Dim vSheet$
Dim vRange$
Dim vWidth As Double
Dim vHeight As Double
Dim vTop As Double
Dim vLeft As Double
Dim vSlide_No As Long
Dim expRng As Range
Dim adminSh As Worksheet
Dim cofigRng As Range
Dim xlfile$
Dim pptfile$
Dim pptfile2$
Dim preOutput As PowerPoint.Presentation
Dim sldOutputNeu As PowerPoint.slide
Dim sldOutputAlt As PowerPoint.slide
Dim varPfadPräsi
Dim intFolieOutput As Integer
Dim intFolieSteuer As Integer
'Möchten sie speichern? Wird ausgeschalten
Application.DisplayAlerts = False
'2.Variablen füllen
Set adminSh = ThisWorkbook.Sheets("Admin")
Set cofigRng = adminSh.Range("Rng_sheets")
xlfile = adminSh.[excelPth]
pptfile = adminSh.[pptPth]
pptfile2 = adminSh.[pptPth2]
'3. Varibalen verarbeiten
'3.1 Grafiken aus Excel in PP einfügen
Set pre = ppt_app.Presentations.Open(pptfile) 'PP ("Vorlage Charts Dortmund") wird geöffnet und der Variable pre zugeordnet
pre.SaveCopyAs pptfile2 'PP unter anderem Namen abspreichern (dieser wird in der Excel manuell vergeben)
pre.Close 'ursprüngliche PP schließen
Set wb = Workbooks.Open(xlfile) 'Ecel Datei aus der die Grafiken kopiert werden öffnen
Set pre = ppt_app.Presentations.Open(pptfile2) 'PP unter neuem Namen öffnen
For Each rng In cofigRng
'--------------------------Set Variables (Variablen mir Werten füllen)
With adminSh
vSheet$ = .Cells(rng.Row, 4).Value
vRange$ = .Cells(rng.Row, 5).Value
vWidth = .Cells(rng.Row, 6).Value
vHeight = .Cells(rng.Row, 7).Value
vTop = .Cells(rng.Row, 8).Value
vLeft = .Cells(rng.Row, 9).Value
vSlide_No = .Cells(rng.Row, 10).Value
End With
'----------------------------Export to PPT
wb.Activate
Sheets(vSheet$).Activate
Set expRng = Sheets(vSheet$).Range(vRange$) 'expRng mit den voreingetstellten Ranges in Excel (aka Grafiken) fülle
expRng.Copy
Set slde = pre.Slides(vSlide_No)
slde.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set shp = slde.Shapes("Grafik 2")
With shp
.Top = vTop
.Left = vLeft
.Width = vWidth
.Height = vHeight
End With
Set shp = Nothing
Set slde = Nothing
Set expRng = Sheets(vSheet$).Range(vRange$)
Application.CutCopyMode = False
Set expRng = Nothing
Next rng
'3.2 PP Folie aus anderer PP in aktueller PP ersetzten
'pptfile = adminSh.[pptPth]
varPfadPräsi = adminSh.[pptpthOutput]
intFolieOutput = adminSh.[FolieOutput]
intFolieSteuer = adminSh.[FolieSteuer]
Debug.Print intFolieSteuer
Set preOutput = ppt_app.Presentations.Open(varPfadPräsi)
ppt_app.ActivePresentation.Slides.Range(11).Select
ppt_app.ActivePresentation.Slides(11).Copy
'preOutput.Visible = False
'Presentation(pre).Activate
'        With ppt_app.pre
'            .Visible = msoTrue
'            .Activate
'        End With
'        With ppt_app.Presentations(pre).Windows(1)
'            If Not .Active Then
'                Set oldwin = Application.ActiveWindow
'                .Activate
'            End If
'        End With
'Set pre = ppt_app.ActivePresentation
'pre (msoBringToFront)
'preOutput.Visible = msoFalse
'pre.Activate
'ppt_app.pre.Activate
ppt_app.ActivePresentation.Slides.Paste 13
ppt_app.ActivePresentation.Slides(14).Delete
preOutput.Close
pre.Save
pre.Close
Set pre = Nothing
Set ppt_app = Nothing
wb.Close False
Set wb = Nothing
Application.DisplayAlerts = True
MsgBox "Präsentation wurde erstellt"
End Sub