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

Question

我尝试使用此代码来处理从Excel工作表到Powerpoint中的表范围的范围。但它没有运行。 请帮忙。

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

我有以下代码：

1. 设置PowerPoint应用，Pres和幻灯片选择设置。
2. 循环选定幻灯片中的所有形状，并查找表类型的形状。
3. 从Excel工作表中复制范围。
4. 它选择您想要的任何表格单元格作为第一行和列来复制Excel范围。

5. 使用PowerPoint表格式或Excel范围格式粘贴到现有表格中。

   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

我有以下代码将excel范围复制到PPT表。