问一个关于vba生成ppt的问题

sunflynankai

用excel vba生成新的ppt，已引用microsoft powerpoint 包。问题是：代码中"ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select "提示错误：“对象不支持该属性或方法”，而在ppt中的vba运行就没有问题。求高手帮助解答。感激不尽。
代码如下：
Sub createfile_ppt(varfilename As String, startdate As Date, enddate As Date)
    Dim PptApp As Object
    Dim PptFile As Object
    Dim PptSlide As Object
    Dim ppttemplatename As String
   
'------------------------------------------------------------------
'设置PPT模板存储位置

    ppttemplatename = "D:\Program Files\Microsoft Office\Templates\Presentation Designs\Ocean.pot"   

'------------------------------------------------------------------   
    '新建ppt应用程序
    Set PptApp = CreateObject("PowerPoint.Application")
   
    PptApp.Visible = True
   
    '新建幻灯片
    Set PptFile = PptApp.Presentations.Add
   
    '设置幻灯片模板
    PptFile.ApplyTemplate Filename:=ppttemplatename
    '第一张幻灯片——题目
    Set PptSlide = PptFile.Slides.Add(Index:=1, Layout:=ppLayoutTitle) '新建幻灯片
'------------------------------------------------------------------------------------
'写入题目

    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select ’选择标题框
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select ’选择标题框文本
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
    With ActiveWindow.Selection.TextRange
        .Text = "生成测试PPT"
        With .Font
            .NameAscii = "Verdana"
            .NameFarEast = "宋体"
            .NameOther = "Verdana"
            .Size = 32
            .Bold = msoTrue
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoFalse
            .Color.SchemeColor = ppBackground
        End With
   End With
'------------------------------------------------------------------------------------

    Set PptShape = Nothing
    Set PptSlide = Nothing
    PptApp.ActivePresentation.SaveAs varfilename
   
    PptFile.Close
    PptApp.Quit
   
    Set PptFile = Nothing
    Set PptApp = Nothing
   
End Sub