运行时错误429 Active X无法创建对象,VBA到PPT

时间:2019-01-25 14:27:49

标签: vba templates runtime-error powerpoint

我正在尝试使用公司模板从excel文件创建PowerPoint。我可以使用模板打开它并参考正确的幻灯片布局,但是每当我运行VBA时,我都会收到一条消息

  

运行时错误429 Active X无法创建对象

,我在模板中得到一个PPT,上面显示的是“点击以添加第一张幻灯片” 。如何让它创建进行下一步所需的对象? VBA同时使用子过程和函数,如下所示。预先感谢!

Public Sub DevOppDeck()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    'Dim ppSlide As PowerPoint.Slide
    Dim DMAName As Variant
    Dim oSlides As Slides, oSlide As Slide

    'Creates a new powerpoint
    Set ppApp = New PowerPoint.Application

    ppApp.Visible = True
    ppApp.Activate


    'Takes user input and finds the DMA name

    userInput = InputBox("Please type in a DMA ID", "Create a Development Opportunity Deck")
    Worksheets("DMA Summary").Range("b4") = userInput

    Set findName = Worksheets("DMA Alignment").Range("C3:G217")
    DMAName = Application.WorksheetFunction.Index(Sheets("DMA Alignment").Range("C3:G217"), _
                                                  Application.WorksheetFunction.Match(Sheets("DMA Summary").Range("B4"), Sheets("DMA Alignment").Range("C3:C217"), 0), _
                                                  Application.WorksheetFunction.Match(Sheets("DMA Summary").Range("A5"), Sheets("DMA Alignment").Range("C3:G3"), 0))

    MsgBox ("Your DMA name is" & Space(1) & DMAName)

    Set ppPres = ppApp.Presentations.Add
    ppPres.ApplyTemplate ("C:\Users\rbiqs000\Documents\Custom Office Templates\RBI-template.potx")

    'Creates first slide in Title Slide latout from Company format

    Set oSlides = ActivePresentation.Slides
    Set oSlide = oSlides.AddSlide(1, GetLayout("Title Slide"))
    oSlide.Select

    'Updates Title and Date

    oSlide.Shapes(1).TextFrame.TextRange.Text = DMAName & Space(1) & "Development Opportunity"
    'ppSlide.Shapes(2).TextFrame.TextRange.InsertDateTime (ppDateTimeMMMMdyyyy)


Public Function GetLayout( _
       LayoutName As String, _
       Optional ParentPresentation As Presentation = Nothing) As CustomLayout

    If ParentPresentation Is Nothing Then
        Set ParentPresentation = ActivePresentation
    End If

    Dim oLayout As CustomLayout
    For Each oLayout In ParentPresentation.SlideMaster.CustomLayouts
        If oLayout.Name = LayoutName Then
            Set GetLayout = oLayout
            Exit For
        End If
    Next
End Function

0 个答案:

没有答案