使用 VBA 将范围从 Excel 工作表复制到 PowerPoint 中的表格

Question

I tried this code for copying a range from an Excel sheet to a table in PowerPoint but it was not run.

ppapp.Visible = True 
For Each sh In ThisWorkbook.Sheets 
If sh.Name Like "E_KRI" Then ppapp.ActivePresentation.Slides.Add   
     ppapp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
     ppapp.ActiveWindow.View.GotoSlide 
     ppapp.ActivePresentation.Slides.Count Set ppSlide = 
     ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count) 
     ppSlide.Select 
     iLastRowReport = Range("B" & Rows.Count).End(xlUp).Row
     Range("A3:J" & iLastRowReport).Copy
     Set tbl = ppapp.ActiveWindow.Selection.ShapeRange.Table
     tbl.Cell(5,3).Shape.paste

Answer 1

I have the following code:

1. It sets the PowerPoint app, Pres and slide selections settings.
2. Loops through all shapes in the selected slide, and looks for the shape of Table type.
3. Copies the Range from Excel Worksheet.
4. It selects whatever Table Cell you want as the first row and column to copy the Excel range.

5. Paste into exisiting table using either the PowerPoint Table format, or the Excel Range format.

    Public Sub ExcelRange_to_PPT_Table() Dim ppApp As PowerPoint.Application Dim ppPres As PowerPoint.Presentation Dim ppTbl As PowerPoint.Shape On Error Resume Next Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application Set ppPres = ppApp.Presentations.Item(1) Else Set ppPres = ppApp.Presentations.Item(1) End If ppApp.ActivePresentation.Slides(1).Select ppPres.Windows(1).Activate ' find on Slide Number 1 which object ID is of Table type (you can change to whatever slide number you have your table) With ppApp.ActivePresentation.Slides(1).Shapes For i = 1 To .count If .Item(i).HasTable Then ShapeNum = i End If Next End With ' assign Slide Table object Set ppTbl = ppApp.ActivePresentation.Slides(1).Shapes(ShapeNum) ' copy range from Excel sheet iLastRowReport = Range("B" & Rows.count).End(xlUp).row Range("A3:J" & iLastRowReport).Copy ' select the Table cell you want to copy to >> modify according to the cell you want to use as the first Cell ppTbl.Table.Cell(3, 1).Shape.Select ' paste into existing PowerPoint table - use this line if you want to use the PowerPoint table format ppApp.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle") ' paste into existing PowerPoint table - use this line if you want to use the Excel Range format ' ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting") End Sub

Answer 2

I have below code to copy excel range to PPT table.