Можно ли экспортировать объекты ListObject так же, как ChartObjects из Excel в Powerpoint в VBA?

Question

То, что я ищу, - это способ экспорта всех графиков с именами ChartObjects вместе со всеми таблицами с именами Listobjects, которые уже созданы на листе («Вывод») файла Excel, в файл Powerpoint.

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

Также я пытаюсь сохранитьэто в порядке листа «Вывод», так как важно сохранить порядок в том же порядке, что и все листы, из которых создаются графики.

Public Sub ChartsToPpt()
  Dim sht As Object
  Dim cht As Excel.ChartObject
  Dim tbl As Excel.ListObject
  Dim AppPpt As Object 'PowerPoint.Application
  Dim prs As Object 'PowerPoint.Presentation

  'Create New Presentation
  Set AppPpt = CreateObject("PowerPoint.Application")
  AppPpt.Visible = msoTrue
  Set prs = AppPpt.Presentations.Add(msoTrue)

  For Each sht In ActiveWorkbook.Sheets
    If sht.Visible = xlSheetVisible Then
      sht.Select
      Select Case LCase(TypeName(sht))
        Case "worksheet"
          For Each cht In sht.ChartObjects
            cht.Select
            Application.CommandBars.ExecuteMso "Copy"
            PasteChart AppPpt, prs
          Next
        Case "chart"
          Application.CommandBars.ExecuteMso "Copy"
          PasteChart AppPpt, prs
      End Select

    Else
      sht.Select
      Select Case LCase(TypeName(sht))
        Case "worksheet"
          For Each tbl In sht.ChartObjects
            tbl.Select
            Application.CommandBars.ExecuteMso "Copy"
            PasteChart AppPpt, prs
          Next
        Case "chart"
          Application.CommandBars.ExecuteMso "Copy"
          PasteChart AppPpt, prs
      End Select

    End If
  Next
End Sub


Private Sub PasteChart(ByVal PowerPointApplication As Object, _
                       ByVal TargetPresentation As Object)
  Dim sld As Object 'PowerPoint.Slide
  Dim cnt As Long
  Const ppLayoutBlank = 12

  Set sld = TargetPresentation.Slides.Add( _
    TargetPresentation.Slides.Count + 1, ppLayoutBlank) 'Add New Slide
  sld.Select
  cnt = sld.Shapes.Count

  PowerPointApplication.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
  Do
   DoEvents
  Loop Until cnt <> sld.Shapes.Count
End Sub

 Public Sub ChartsToPptAsImage()
  Dim sht As Object
  Dim cht As Excel.ChartObject
  Dim tbl As Excel.ListObject
  Dim AppPpt As Object 'PowerPoint.Application
  Dim prs As Object 'PowerPoint.Presentation

  'Create New Presentation
  Set AppPpt = CreateObject("PowerPoint.Application")
  AppPpt.Visible = msoTrue
  Set prs = AppPpt.Presentations.Add(msoTrue)

  For Each sht In ActiveWorkbook.Sheets
    If sht.Visible = xlSheetVisible Then
      Select Case LCase(TypeName(sht))
        Case "worksheet"
          For Each cht In sht.ChartObjects
            cht.CopyPicture Appearance:=xlScreen, _
                            Format:=xlBitmap
            PasteChartImage prs
          Next
        Case "chart"
          sht.ChartArea.Copy
          PasteChartImage prs
      End Select
     Else
      Select Case LCase(TypeName(sht))
        Case "worksheet"
          For Each tbl In sht.ChartObjects
            cht.CopyPicture Appearance:=xlScreen, _
                            Format:=xlBitmap
            PasteChartImage prs
          Next
        Case "chart"
          sht.ChartArea.Copy
          PasteChartImage prs
        End Select




    End If
  Next
End Sub

Private Sub PasteChartImage(ByVal TargetPresentation As Object)
  Dim sld As Object 'PowerPoint.Slide
  Const ppLayoutBlank = 12
  Const ppPasteBitmap = 1

  Set sld = TargetPresentation.Slides.Add( _
    TargetPresentation.Slides.Count + 1, ppLayoutBlank) 'Add New Slide
  With sld.Shapes.PasteSpecial(DataType:=ppPasteBitmap, Link:=msoFalse)
    .Height = 900
    .Width = 900
    .Align msoAlignCenters, True
    .Align msoAlignMiddles, True
  End With
End Sub

В настоящее время я не знаю, как экспортировать объекты ListObjects в Powerpointвместе с ChartObjects