Экспортировать панель Excel в PowerPoint

Question

Я пытаюсь создать генератор PPT на основе файла Excel и ввода пользователя.До сих пор мне удалось создать пользовательскую форму, в которой пользователь определяет, какие отчеты из Excel (диаграмма плюс таблица) он хочет видеть на презентации.Чтобы определить, какой отчет был выбран, я использовал глобальные переменные.Теперь, когда я пытаюсь сгенерировать презентацию, я получаю сообщение об ошибке: «Ошибка времени выполнения« -2147023170 (800706b3) »: ошибка автоматизации. Ошибка удаленного вызова процедуры».Отладка показывает строку newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly У меня есть несколько таких строк, так как я использую функцию For, чтобы проверить, был ли выбран отчет (на основе моих глобальных переменных), и если да, то повторите код для каждого отчета.Ниже приведен сам код.Я не уверен, что делаю не так.

Sub CreatePowerPoint()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'declare the variables
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim This As Workbook
    Set This = ActiveWorkbook

 'look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

 'create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
        newPowerPoint.Presentations.Add
        newPowerPoint.Visible = True

 'TBA Starting Slides/Agenda
       *Code here*


'Check if report was selected, if yes perform addition of new slides with graphs and tables

If CB1 = 1 Then
This.Worksheets("Coverage Summary").Select
    For Each cht In ActiveSheet.ChartObjects

    'Add a new slide
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Copy the chart and paste it into the PP
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteChartObject).Select

    'Set the title of the slide
        activeSlide.Shapes(1).TextFrame.TextRange.Text = "Coverage Summary" 

    'Adjust the positioning
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

    Next
Set activeSlide = Nothing
End If

If CB2 = 1 Then
This.Worksheets("Additions Report").Select
    For Each cht In ActiveSheet.ChartObjects

    'Add a new slide
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Copy the chart and paste it into the PP
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteChartObject).Select

    'Set the title of the slide
        activeSlide.Shapes(1).TextFrame.TextRange.Text = "Additions summary" 

    'Adjust the positioning
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

    Next
Set activeSlide = Nothing
End If

If CB3 = 1 Then
This.Worksheets("End of Coverage Report").Select
*Same code as above*
Set activeSlide = Nothing
End If

If CB4 = 1 Then
This.Worksheets("LDoS Summary").Select
*Same code as above*
End If

If CB5 ... * and so on

У меня кончаются идеи.Я не знаю, как исправить код.Может кто-нибудь помочь, пожалуйста?

Answer 1

Мое предложение - не «выбирать» объекты, когда вы программно создаете PowerPoint из Excel vba и используете ActiveSheet и т. П .;непосредственно установите объекты на листы, с которыми вы хотите работать.Тем не менее, хотя и не полностью очистить ваш код ... это работает (отмечая только для CB1 ..., но остальное должно быть похоже):

ОБНОВЛЕНИЕ КОДА

Option Explicit

Sub CreatePowerPoint()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'declare the variables
    Dim newPowerPoint As PowerPoint.Application
    Dim newPresentation As Presentation
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim This As Workbook
    Set This = ActiveWorkbook

    Dim newWorksheet As Worksheet

     'look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

     'create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
    Set newPresentation = newPowerPoint.Presentations.Add
    newPowerPoint.Visible = True

     'TBA Starting Slides/Agenda
     '  *Code here*

    'Check if report was selected, if yes perform addition of new slides with graphs and tables

    'If CB1 = 1 Then
    If 1 = 1 Then
        Set newWorksheet = This.Worksheets("Coverage Summary")
        For Each cht In newWorksheet.ChartObjects

            'Add a new slide and setup the slide title
            Set activeSlide = newPresentation.Slides.Add(newPresentation.Slides.Count + 1, ppLayoutTitleOnly)
            activeSlide.Shapes(1).TextFrame.TextRange.Text = "Coverage Summary"

            ' Copy in the chart and adjust its position
            cht.Copy
            activeSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
            With activeSlide.Shapes(activeSlide.Shapes.Count)
                .Top = 125
                .Left = 15
                ' and could you also set .Width and .Height here as well ...
            End With

        Next
    End If

    'If CB2 = 1 Then
    If 1 = 1 Then
        Set newWorksheet = This.Worksheets("Additions Report")
        For Each cht In newWorksheet.ChartObjects

            'Add a new slide and setup the slide title
            Set activeSlide = newPresentation.Slides.Add(newPresentation.Slides.Count + 1, ppLayoutTitleOnly)
            activeSlide.Shapes(1).TextFrame.TextRange.Text = "Additions Report"

            ' Copy in the chart and adjust its position
            cht.Copy
            activeSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
            With activeSlide.Shapes(activeSlide.Shapes.Count)
                .Top = 125
                .Left = 15
                ' and could you also set .Width and .Height here as well ...
            End With

        Next
    End If

End Sub

Вот изображение набора тестовых данных

Вот изображение вывода PowerPoint ...

Надеюсь, это поможет.