Отчеты Excel, вставленные в PowerPoint как изображения - PullRequest
Новая
       19

Отчеты Excel, вставленные в PowerPoint как изображения

0 голосов
/ 09 февраля 2020

У меня есть отчет, в котором я хотел бы иметь таблицу с указанием именованного диапазона и номера слайда, в который этот отчет Excel нужно вставить в шаблон PowerPoint в виде изображения.

Мне удалось загрузить массивы, но я не могу скопировать с помощью массива.

Я могу жестко закодировать диапазон в коде, и он работает, но это не идеально.

Я пытался Sheet2.Range("Report_1") в массив и ничего не скопировал. 

Sub PasteMultipleSlides()
    'www.spreadsheet guru
    Dim myPresentation As Object, mySlide As Object, PowerPointApp As Object, shp As Object
    Dim MySlideArray As Variant, MyRangeArray As Variant
    Dim x As Long

    'Create an Instance of PowerPoint
    On Error Resume Next
    'Is PowerPoint already opened?
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    'Clear the error between errors
    Err.Clear
    'If PowerPoint is not already open then Exit
    If PowerPointApp Is Nothing Then
        MsgBox "PowerPoint Presentation is not open, aborting."
        Exit Sub
    End If
    'Handle if the PowerPoint Application is not found
    If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
    End If
    On Error GoTo 0

   'Make PowerPoint Visible and Active
   PowerPointApp.ActiveWindow.Panes(2).Activate

   'Create a New Presentation
   Set myPresentation = PowerPointApp.ActivePresentation

   'List of PPT Slides to Paste to
   MySlideArray = Array(3, 4)

   'List of Excel Ranges to Copy from
   MyRangeArray = Array(Sheet2.Range("Report_1"), Sheet3.Range("Report_2"))

   'Loop through Array data
    For x = LBound(MySlideArray) To UBound(MySlideArray)

        'delete images on slide

        'Copy Excel Range
        MyRangeArray(x).Copy

        'Paste to PowerPoint and position
        On Error Resume Next

        'Excel 2007-2010
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)

        'Excel 2013
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange
        On Error GoTo 0

        'Center Object
        With myPresentation.PageSetup
            shp.Left = 70   '(.SlideWidth \ 2) - (shp.Width \ 2)
            shp.Top = 70    '(.SlideHeight \ 2) - (shp.Height \ 2)
        End With

    Next x

    'Transfer Complete
    Application.CutCopyMode = False
    ThisWorkbook.Activate
    MsgBox "Complete"

End Sub
...