VBA把excel中的图表复制到现有PPT中

以下是使用 VBA 将 Excel 中的图表复制到现有的 PPT 中的示例代码：

Sub CopyChartToPPT()
    ' 定义变量
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.Slide
    Dim pptShape As PowerPoint.Shape
    Dim pptChart As PowerPoint.Chart
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim chtObj As ChartObject
    Dim chtImg As String
    
    ' 打开现有的 PPT 文件
    Set pptApp = New PowerPoint.Application
    Set pptPres = pptApp.Presentations.Open("your_existing_ppt_file_name.pptx")
    
    ' 打开 Excel 文件并获取图表对象
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    Set chtObj = ws.ChartObjects(1)
    Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, ppLayoutBlank)
    
    ' 将图表保存为图片文件
    chtImg = Environ$("temp") & "\" & chtObj.Chart.Name & ".png"
    chtObj.Chart.Export Filename:=chtImg, FilterName:="PNG"
    
    ' 在现有的 PPT 中添加新幻灯片并插入图片
    Set pptShape = pptSlide.Shapes.AddPicture(FileName:=chtImg, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
    
    ' 调整图片大小和位置
    pptShape.LockAspectRatio = msoTrue
    pptShape.Width = 500
    pptShape.Top = 100
    pptShape.Left = 100
    
    ' 添加标题和副标题
    Set pptChart = pptShape.Chart
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = chtObj.Chart.ChartTitle.Text
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = "This is a chart copied from Excel"
    
    ' 关闭 PPT 文件和 Excel 文件
    pptPres.Save
    pptPres.Close
    pptApp.Quit
    Set pptApp = Nothing
    Set pptPres = Nothing
    Set pptSlide = Nothing
    Set pptShape = Nothing
    Set pptChart = Nothing
    Set wb = Nothing
    Set ws = Nothing
    Set chtObj = Nothing
    
    ' 删除临时图片文件
    Kill chtImg
End Sub

上述代码中，`ws.ChartObjects(1)` 表示获取 Excel 文件中的第一个图表对象。`Shapes.AddPicture()` 方法用于将图片插入到 PPT 中。`pptSlide.Shapes.Title.TextFrame.TextRange.Text` 和 `pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text` 用于添加幻灯片的标题和副标题。最后，调用 `pptPres.Save` 方法保存修改后的 PPT 文件。