使用VBA获取PowerPoint图表到Excel工作表的数据

Question

因此，当您右键单击PowerPoint中的图表时，然后单击编辑数据。一个工作簿将打开。我只希望将这些数据复制到我的Excel文件中。帮助我提取PowerPoint每张幻灯片中的每个图表。请帮助我这是我到目前为止ppt vba中的代码：

sub powerpointtoexcel（）

Dim PPTPres As Presentation
Dim PPTSlide As Slide
Dim PPTShape As Shape
Dim PPTTable As Table
Dim PPTChart As Chart
Dim PPTPlaceHolder As PlaceholderFormat

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range

Dim PPTChartData As MSForms.DataObject

Set PPTPres = Application.ActivePresentation

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")
Set xlBook = xlApp.Workbooks("Book2.xlsx")
Set xlSheet = xlBook.Worksheets("Sheet2")

Set PPTChartData = New MSForms.DataObject

For Each PPTSlide In PPTPres.Slides

    For Each PPTShape In PPTSlide.Shapes
    
        If PPTShape.HasChart Then
        
            Set PPTChart = PPTShape.Chart
            
        
            Set xlRange = xlSheet.Range("A10000").End(xlUp)
            
            If xlRange.Value <> "" Then
                
                Set xlRange = xlRange.Offset(1, 0)
                
            End If
            
            With PPTPres.Slides(PPTSlide).Shapes(PPTShape).Chart.ChartData
            .Activate
            .Workbook.Sheets(1).Range("A2:E10").Copy
            
            PPTChartData.GetFromClipboard
            
            End With
            
            SData = PPTChartData.GetText(1)
            xlRange.Value = SData
            xlRange.Offset(0, 1).Value = PPTSlide.Name
            xlRange.Offset(0, 2).Value = PPTChart.ChartData
            
        
        End If
        
    Next
    
Next




End Sub