使用VBA將Powerpoint圖表標簽提取到Excel

Question

我需要找到一種從PowerPoint圖表提取圖表數據標簽到Excel的方法，因為給我的PowerPoint圖表有很多次鏈接數據損壞。

我寫了下面的代碼，但是我不知道For Each datapoint In chtnow.SeriesCollection(1).Points...之后要做什么For Each datapoint In chtnow.SeriesCollection(1).Points...

Sub Extract_Datalabels()
'Goal: To extract datalabels of Chart's series collection and write to excel        
    Dim datapoint As Point
    Dim sh As Shape
    Dim sld As Slide
    Dim chtnow As Chart
    Dim label As DataLabel
    Dim xlApp As New Excel.Application
    Dim xlWorkbook As Excel.Workbook
    Dim xlworksheet As Excel.Worksheet

    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlworksheet = xlWorksheets.Add
    xlApp.Visible = True

    Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
    For Each datapoint In chtnow.SeriesCollection(1).Points
    'Extract data labels
        If datapoint.HasDataLabel Then

            [No clue how to write to Excel]

        End If
    Next
End Sub

Answer 1

如果其他代碼都可以正常工作，則這是在excel中寫入xlworksheet第一列的簡便方法：

Dim cnt As Long
If datapoint.HasDataLabel Then
    cnt = cnt + 1
    xlworksheet.Cells(cnt, 1) = datapoint.label
End If

但是，我不確定在設置xlApp.Visible = True是否可以執行類似Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart 。

Answer 2

您的示例有幾個類型錯誤，但這應該可以為您完成工作。 您將需要添加對Microsoft Excel [A Number] Object Library的引用，以使用Excel對象類型和所有派生對象。

所有測試均使用條形圖進行。

Sub Extract_Datalabels()
''Goal: To extract datalabels of Chart's series collection and write to excel
    Dim datapoint   As ChartPoint
    Dim chtnow      As Chart

    Dim xlApp       As New Excel.Application
    Dim xlWorkbook  As Excel.Workbook
    Dim xlworksheet As Excel.Worksheet
    Dim Row         As Long

    Let xlApp.SheetsInNewWorkbook = 1

    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlworksheet = xlWorkbook.Worksheets(1)
    Let xlApp.Visible = True
    Call VBA.DoEvents

    Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
    Let Row = 1
    For Each datapoint In chtnow.SeriesCollection(1).Points
        'Extract data labels
        If datapoint.HasDataLabel Then
            Let xlworksheet.Cells(Row, 1) = datapoint.DataLabel.Text
        End If
        Let Row = Row + 1
    Next
End Sub