Ошибка времени выполнения 429 Active X не может создать объект, VBA в PPT - PullRequest
Новая
       10

Ошибка времени выполнения 429 Active X не может создать объект, VBA в PPT

0 голосов
/ 25 января 2019

Я пытаюсь создать PowerPoint из файла Excel, используя шаблон компании. Я могу открыть новый powerpoint с помощью шаблона и указать правильные макеты слайдов, но всякий раз, когда я запускаю свой VBA, я получаю сообщение

Ошибка времени выполнения 429 Активно 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
...