使用VBA将范围从Excel复制到现有PowerPoint表

Question

I want to copy a selection of columns from an excel table to an existing PowerPoint table.

This is the code I used and tried to modify to my needs but it didn't work. The code copies the tables to PP but keeps the excel format.

`Sub PasteMultipleSlides()

'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim 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(2, 3)

'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheets("Tabelle1").Range("Tabelle1[#All]"), Sheets("Tabelle6").Range("Tabelle14[#All]"))

'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    'Copy Excel Range
        MyRangeArray(x).Copy

    'Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0

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

  Next x

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

End Sub

These are the columns I would like to copy to a table on slide 2 in PP:

Sheets("Tabelle6")
    Range("Tabelle14[[company ]]").Select
    Range("Tabelle14[customer number]").Select
    Range("Tabelle14[order number]").Select
    Range("Tabelle14[order value]").Select

And these are the columns I would like to copy to a table on slide 3 in PP:

Sheets("Tabelle1")
    Range("Tabelle1[[company ]]").Select
    Range("Tabelle1[customer number]").Select
    Range("Tabelle1[order number]").Select
    Range("Tabelle1[order value]").Select

I hope you can help me! Thanks!

Answer 1

When it comes to bringing data from Excel to Powerpoint you need to iterate across all cells as dwirony explained. But instead of working only on Excel ranges, you can address the Excel table column ranges via (eg)

activesheet.listobjects(i).listcolumns(j).range

A good thing to simplify this task would be to prepare the Powerpoint table data in Excel in such a way that you have a kind of staging area. This could be a range next to your table which contains only the desired columns for Powerpoint (formulas would be simple referencing, eg "=A3"). Then you could apply a simpler VBA algorithm as it would be just Excel range to Powerpoint table as a whole without thinking of the column mapping instead)

In case you would like to have it more comfortable without coding, you could also try SlideFab ( https://slidefab.com ) which can link Excel tables to Powerpoint and updates the data automatically. Disclaimer: It's my software.

Cheers

Jens