Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-07-2015, 12:22 AM
JohnWilson JohnWilson is offline Power Point - Deleting Legend enteries via VBA Windows 7 64bit Power Point - Deleting Legend enteries via VBA Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,914
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

You can check the position which probably determines the order.



example

If ocht.Legend.Position <> xlLegendPositionBottom Then
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #2  
Old 06-07-2015, 06:46 AM
PowerPoint_VBA PowerPoint_VBA is offline Power Point - Deleting Legend enteries via VBA Windows 8 Power Point - Deleting Legend enteries via VBA Office 2010 32bit
Novice
Power Point - Deleting Legend enteries via VBA
 
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
Reply

Tags
powerpoint macro



Similar Threads
Thread Thread Starter Forum Replies Last Post
can power point LINK to embedded object in power point ? johnseito PowerPoint 0 05-24-2014 04:31 AM
Power Point - Deleting Legend enteries via VBA Power Point and Flash Paincho PowerPoint 1 06-27-2011 08:07 AM
Microsoft Power Point 2004 to Office Power Point 2007 chuff PowerPoint 0 03-20-2011 01:23 PM
Power Point on the Web Carthalion PowerPoint 0 03-03-2010 09:59 AM
power point ladonna12 PowerPoint 2 02-16-2009 09:34 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:49 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft