Search code examples
vbapowerpoint

Deleting all datalabels except the last two in i time series


I need a macro for deleting all datalabels in a linechart except the last two. I've managed to delete one column of labels, any help on how i can delete the rest.

Here is the code im using currently:

Option Explicit
Sub Format_linechart()

    Dim sld As Slide
    Dim shp As Shape
    Dim chart As chart
    Dim sr As Series
    Dim i As Long
    Dim Cnt As Integer
    
    Set sld = Application.ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.HasChart Then
            Set chart = shp.chart
            For i = 1 To chart.SeriesCollection.Count
                Set sr = chart.SeriesCollection(i)
                sr.HasDataLabels = True
                sr.Points(sr.DataLabels.Count - 2).DataLabel.Delete
            Next i
        End If
    Next shp

End Sub

I've also tried adding lines for each set of datalabels but i then get an error if there are to few datapoints in the chart.

Option Explicit
Sub Format_linechart()

    Dim sld As Slide
    Dim shp As Shape
    Dim chart As chart
    Dim sr As Series
    Dim i As Long
    Dim Cnt As Integer
    
    Set sld = Application.ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.HasChart Then
            Set chart = shp.chart
            For i = 1 To chart.SeriesCollection.Count
                Set sr = chart.SeriesCollection(i)
                sr.HasDataLabels = True
                sr.Points(sr.DataLabels.Count - 2).DataLabel.Delete
                sr.Points(sr.DataLabels.Count - 3).DataLabel.Delete
                sr.Points(sr.DataLabels.Count - 4).DataLabel.Delete
                sr.Points(sr.DataLabels.Count - 5).DataLabel.Delete
                sr.Points(sr.DataLabels.Count - 6).DataLabel.Delete
            Next i
        End If
    Next shp

End Sub


Solution

  • For each each series, you can loop through each point and delete the data label for the desired points . . .

    Option Explicit
    
    Sub Format_linechart()
    
        Dim sld As Slide
        Dim shp As Shape
        Dim chart As chart
        Dim sr As Series
        Dim i As Long
        Dim j As Long
        Dim Cnt As Integer
    
        Set sld = Application.ActiveWindow.View.Slide
        
        For Each shp In sld.Shapes
            If shp.HasChart Then
                Set chart = shp.chart
                For i = 1 To chart.SeriesCollection.Count
                    Set sr = chart.SeriesCollection(i)
                    sr.HasDataLabels = True
                    For j = 1 To sr.Points.Count - 2
                        sr.Points(j).DataLabel.Delete
                    Next j
                Next i
            End If
        Next shp
    
    End Sub