Kein Aufruf einer Powerpointprozedur aus Excel

Sub präsentationen_erstellen()
Dim PP As Object
Dim tparray As Variant
Dim jArray As Integer
Dim appPP, objDoc As Object
Dim i As Integer
Dim sh, ppPres As Object
tparray = Array("BB, KRM, ZV", "WP", "Prov & VVW", "Quer & Migration", "AIDA", "AKP_APP", "  _
_
LPT", "PEV", "PK")
For jArray = 0 To 1 'UBound(tparray)
Set PP = CreateObject("Powerpoint.Application")
PP.Visible = True
PP.Presentations.Open Filename:="R:\Projekte\P054_CBS\700 Test\SIT\Test Durchfü _
hrungsmanagement\Master\cbs_SIT_Template_" & tparray(jArray) & ".ppt"
PP.Activate
PP.Run "'cbs_SIT_Template_" & tparray(jArray) & ".ppt"'!A"
PP.SaveAs Filename:="R:\Projekte\P054_CBS\700 Test\SIT\Test Durchführungsmanagement\TR-  _
_
F1\TP-Statistiken\" & tparray(jArray) & "\CBS_SIT_Statusreport_" & tparray(jArray) & "_" & yr &  _
"-0" & mth & "-" & dy & ".ppt"
PP.Close
Set PP = Nothing
Next jArray
End Sub
Und das ist die Prozedur in Powerpoint:
Sub  A()         ' Hatte auch schon Public probiert, jedoch ohne Erfolg
Dim i As Integer
Dim sh, ppPres As Object
Set ppPres = ActivePresentation
For i = 1 To ppPres.Slides.Count
For Each sh In ppPres.Slides(i).Shapes
If sh.Type = msoLinkedOLEObject Then
With sh.LinkFormat
.Update
End With
End If
Next
Next i
ActiveWindow.ViewType = 9
ActivePresentation.Slides(2).Select
ActiveWindow.Selection.SlideRange.Shapes("Text Box 44").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=25, Length:=8). _
Select
With ActiveWindow.Selection.TextRange
.Text = Date
With .Font
.Name = "Arial"
.Size = 24
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(Red:=0, Green:=51, Blue:=102)
End With
End With
ActiveWindow.Selection.Unselect
End Sub