使用 VBA 在 PowerPoint 中复制从 Excel sheet 到 table 的范围

Question

我尝试使用此代码在 PowerPoint 中复制从 Excel sheet 到 table 的范围，但它不是运行。

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

我有以下代码：

它设置 PowerPoint 应用、Pres 和幻灯片选择设置。
遍历所选幻灯片中的所有形状，并查找 Table 类型的形状。
从 Excel 工作表复制范围。
它会选择您想要的任何 Table 单元格作为第一行和第一列来复制 Excel 范围。

使用 PowerPoint Table 格式或 Excel 范围格式粘贴到现有 table。

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 table。

使用 VBA 在 PowerPoint 中复制从 Excel sheet 到 table 的范围

Copy range from Excel sheet to table in PowerPoint using VBA

excel

powerpoint

vba

range