View Single Post
 
Old 06-07-2015, 06:46 AM
PowerPoint_VBA PowerPoint_VBA is offline Windows 8 Office 2010 32bit
Novice
 
Join Date: Jun 2015
Posts: 3
PowerPoint_VBA is on a distinguished road
Default

It is working now!

Thank you very much for your help!!!

Working code:

Code:
Sub DeleteZero_Legend_Entry()
Dim m As Integer
Dim z As Integer
Dim w As Integer
Dim Counter As Integer
Dim a As Variant
Dim L As Integer
Dim ocht As Chart
Dim b_val As Boolean
Dim oshp As Shape
Dim osld As Slide


'Checking all Slides
For Each osld In ActivePresentation.Slides
    'Checking all Shapes
    For Each oshp In osld.Shapes
        'Do next steps only if shape is a chart
        If oshp.HasChart Then
            'Set ocht as chart which will be checked
            Set ocht = oshp.Chart
                'Do next steps only if chart has legend
                If ocht.HasLegend Then
                    'Extra variable
                    Counter = 0
                    'Checking if Legend order is appropriate or not - it gives two ways to delete legend entry
                    If ocht.Legend.Position <> xlLegendPositionBottom Then
                    
                    'Start - First deleting option

                        'Checking all series collecion
                        For m = ocht.SeriesCollection.Count To 1 Step -1
                            'Extra variable
                            z = ocht.SeriesCollection.Count
                            'Array variable containing all "m" collection values
                            a = ocht.SeriesCollection(m).Values
                                'Checking each collection point value...
                                For L = 1 To ocht.SeriesCollection(m).Points.Count
                                    '... If any collection point is not 0 then b_val equals true - those series collection which has at least one such point will not be deleted
                                    If a(L) <> 0 Then b_val = True
                                Next L
                                'Extra variable
                                w = z - m + 1 - Counter
                                'Deleting legend entry if collection has no data
                                If Not b_val Then
                                    ocht.Legend.LegendEntries(w).Delete
                                    'Counter is neccessary to delete appropriate legend entery number
                                    Counter = Counter + 1
                                End If
                            b_val = False
   
                        Next m


                    'Stop - First deleting option


                    Else
                    'Start - Second deleting option

                        'Checking all series collecion
                        For m = ocht.SeriesCollection.Count To 1 Step -1
                            'Array variable containing all "m" collection values
                            a = ocht.SeriesCollection(m).Values
                                'Checking each collection point value...
                                For L = 1 To ocht.SeriesCollection(m).Points.Count
                                    '... If any collection point is not 0 then b_val equals true - those series collection which has at least one such point will not be deleted
                                    If a(L) <> 0 Then b_val = True
                                Next L

                                'Deleting legend entry if collection has no data
                                If Not b_val Then ocht.Legend.LegendEntries(m).Delete
                            b_val = False
                        Next m

                    'Stop - Second deleting option

                    End If



                End If 'Legend check
        End If 'Chart check
    Next oshp 'Each shape check
Next osld 'Each slide check

End Sub
Reply With Quote