Excel VBA: Excel范围到刚打开的powerpoint

Sub ExportToPowerPoint()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim rng As Range
    Dim i As Integer
    
    ' 创建PowerPoint应用程序对象
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    
    ' 创建一个新的演示文稿
    Set pptPres = pptApp.Presentations.Add
    
    ' 循环遍历Excel中的每个工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 在PowerPoint中创建一个新的幻灯片
        Set pptSlide = pptPres.Slides.Add(1, 11) ' 11表示幻灯片布局
        
        ' 将当前工作表的数据复制到剪贴板
        ws.UsedRange.Copy
        
        ' 将剪贴板中的数据粘贴到PowerPoint幻灯片中
        pptSlide.Shapes.PasteSpecial DataType:=2 ' 2表示粘贴为图片
        
        ' 调整幻灯片中图片的位置和大小
        With pptSlide.Shapes(1)
            .Left = 50
            .Top = 50
            .Width = 500
            .Height = 300
        End With
        
        ' 清空剪贴板
        Application.CutCopyMode = False
        
        ' 设置幻灯片标题
        pptSlide.Shapes.Title.TextFrame.TextRange.Text = ws.Name
        
        ' 设置幻灯片布局
        pptSlide.Layout = 7 ' 7表示标题和内容布局
    Next ws
    
    ' 释放对象
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub