Prozedur zu groß

Sub XLSM_TO_PPT0() ' If UserForum = Gate 0
Dim strPfad As String
Dim strpotx As String
Dim pptapp As Object
Dim pptPres As Presentation
strPfad = "A:\ABLAGE\NBD Standardisierung (Jens Böven)\Präsentation\"
strpotx = "at_Vorlage.potx"
Set pptapp = New PowerPoint.Application
pptVorlage = strPfad & strpotx
pptapp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue
Set pptPres = pptapp.ActivePresentation
'============================================================================================ _
pptPres.Slides(1).Select ' Frontpage
pptPres.Slides(1).Shapes("Rectangle 2").TextFrame.TextRange.Characters.Text = Range(" _
customer1").Value & "-" & Range("model").Value
pptPres.Slides(1).Shapes("Textfeld 7").TextFrame.TextRange.Characters.Text = Range("PrgMgr") _
.Value
pptPres.Slides(1).Shapes("Textfeld 8").TextFrame.TextRange.Characters.Text = Range(" _
Function").Value
pptPres.Slides(1).Shapes("Textfeld 10").TextFrame.TextRange.Characters.Text = Range("date0") _
.Value
pptPres.Slides(1).Shapes("Textfeld 9").TextFrame.TextRange.Characters.Text = Range(" _
location").Value
pptPres.Slides(1).Shapes("Abgerundetes Rechteck 1").TextFrame.TextRange.Characters.Text =  _
Range("Gate1").Value
If Range("Gate1") = ("Gate can be passed") Then
pptPres.Slides(1).Shapes("Abgerundetes Rechteck 1").Fill.ForeColor.RGB = RGB(0, 128, 0)
Else
pptPres.Slides(1).Shapes("Abgerundetes Rechteck 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
'=========================================================================================== _
pptPres.Slides(2).Select ' Program Overview
pptPres.Slides(2).Shapes("Textfeld 4").TextFrame.TextRange.Characters.Text = Range(" _
customer1").Value
pptPres.Slides(2).Shapes("Textfeld 9").TextFrame.TextRange.Characters.Text = Range("sop"). _
Value
pptPres.Slides(2).Shapes("Textfeld 11").TextFrame.TextRange.Characters.Text = Range(" _
lifetime").Value
pptPres.Slides(2).Shapes("Textfeld 12").TextFrame.TextRange.Characters.Text = Range(" _
Volumes_L").Value
pptPres.Slides(2).Shapes("Textfeld 13").TextFrame.TextRange.Characters.Text = Range(" _
Volumes_Y").Value
pptPres.Slides(2).Shapes("Textfeld 14").TextFrame.TextRange.Characters.Text = Range(" _
element1").Value & "," & Range("element2").Value & "," & Range("element3").Value & "," & Range("element4").Value & "," & Range("element5").Value
pptPres.Slides(2).Shapes("Textfeld 15").TextFrame.TextRange.Characters.Text = Range(" _
Customer_Plant").Value
pptPres.Slides(2).Shapes("Textfeld 16").TextFrame.TextRange.Characters.Text = Range(" _
Customer_Development").Value
'=========================================================================================== _
pptPres.Slides(3).Select ' Milestone
pptPres.Slides(3).Shapes("Textfeld 210").TextFrame.TextRange.Characters.Text = Range(" _
Nomination").Value
pptPres.Slides(3).Shapes("Textfeld 211").TextFrame.TextRange.Characters.Text = Range(" _
PT_Design_Freeze").Value
pptPres.Slides(3).Shapes("Textfeld 209").TextFrame.TextRange.Characters.Text = Range(" _
Serial_Design_Release").Value
pptPres.Slides(3).Shapes("Textfeld 212").TextFrame.TextRange.Characters.Text = Range(" _
Parts_100").Value
pptPres.Slides(3).Shapes("Textfeld 213").TextFrame.TextRange.Characters.Text = Range("PPAP") _
.Value
pptPres.Slides(3).Shapes("Textfeld 214").TextFrame.TextRange.Characters.Text = Range("Built" _
).Value
pptPres.Slides(3).Shapes("Textfeld 215").TextFrame.TextRange.Characters.Text = Range("sop_c" _
).Value
pptPres.Slides(3).Shapes("Textfeld 208").TextFrame.TextRange.Characters.Text = Range(" _
Gate_0").Value
pptPres.Slides(3).Shapes("Textfeld 207").TextFrame.TextRange.Characters.Text = Range(" _
Gate_1").Value
pptPres.Slides(3).Shapes("Textfeld 203").TextFrame.TextRange.Characters.Text = Range(" _
Gate_2").Value
pptPres.Slides(3).Shapes("Textfeld 204").TextFrame.TextRange.Characters.Text = Range(" _
Gate_3").Value
pptPres.Slides(3).Shapes("Textfeld 205").TextFrame.TextRange.Characters.Text = Range(" _
Gate_4").Value
pptPres.Slides(3).Shapes("Textfeld 206").TextFrame.TextRange.Characters.Text = Range(" _
Gate_5").Value
pptPres.SaveAs strPfad & ("GatePresentation") & "_" & Range("customer1") & "_" & Range(" _
projectcode") & "_" & ("Gate 1") & "_" & Range("PrgMgr") & ".ppt"
pptPres.Close
Set pptPres = Nothing
Set pptapp = Nothing
End Sub