用Excel vba将对象放入PowerPoint表中

Sub CopyToPowerPoint()
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.Slide
    Dim pptTable As PowerPoint.Table
    Dim ws As Worksheet
    Dim rng As Range
    
    ' 设置要复制的Excel范围
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rng = ws.Range("A1:B2") ' 举例：复制A1到B2的范围
    
    ' 创建或获取PowerPoint应用程序实例
    On Error Resume Next
    Set pptApp = GetObject(, "PowerPoint.Application")
    If pptApp Is Nothing Then
        Set pptApp = New PowerPoint.Application
    End If
    On Error GoTo 0
    
    ' 显示PowerPoint应用程序（可选）
    pptApp.Visible = msoTrue
    
    ' 创建一个新的演示文稿或获取现有的演示文稿
    If pptApp.Presentations.Count = 0 Then
        Set pptPres = pptApp.Presentations.Add
    Else
        Set pptPres = pptApp.ActivePresentation
    End If
    
    ' 在演示文稿中添加一个新的幻灯片
    Set pptSlide = pptPres.Slides.Range(Array(2)).InsertSlide(2) ' 在第2个位置插入新幻灯片
    
    ' 在幻灯片中添加一个表格
    Set pptTable = pptSlide.Shapes.AddTable(2, 2, 100, 100, 100, 100).Table ' 2x2表格，位置和大小可调整
    
    ' 将Excel范围的内容复制到PowerPoint表格中
    rng.Copy
    pptTable.Cell(1, 1).Shape.Select
    pptApp.ActiveWindow.View.PasteSpecial ppPasteText ' 使用文本粘贴，保持格式
    
    ' 清理
    Set pptTable = Nothing
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub