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

Question

我想将选择的列从excel表复制到现有的PowerPoint表。

这是我使用过的代码，试图根据自己的需要进行修改，但是没有用。 该代码将表复制到PP，但保留excel格式。

`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

这些是我想复制到PP中幻灯片2上的表格中的列：

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

这些是我想复制到PP中幻灯片3上的表格中的列：

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

我希望你能帮帮我！ 谢谢！

Answer 1

将数据从Excel导入到Powerpoint时，您需要按照dwirony的说明遍历所有单元格。 但是，您不仅可以使用Excel范围，还可以通过（例如）解决Excel表列范围

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

简化此任务的一件好事是在Excel中以某种临时区域的方式准备Powerpoint表数据。 这可能是表格旁边的范围，该表格仅包含Powerpoint所需的列（公式很容易引用，例如“ = A3”）。 然后，您可以应用更简单的VBA算法，因为它只是整个Powerpoint表的Excel范围，而无需考虑列映射）

如果您希望不用编码就更舒适，也可以尝试SlideFab（ https://slidefab.com ），它可以将Excel表链接到Powerpoint并自动更新数据。 免责声明：这是我的软件。

干杯

詹斯