Microsoft Office Forums Power Point - Deleting Legend enteries via VBA

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-06-2015, 12:07 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 Power Point - Deleting Legend enteries via VBA

Hello,

I am preparing automization for data in excel and presentation. The last thing I struggle with is deleting unnecessary legend entries in power point.

I suppose I would be able to get rid of them in excel via VBA, but still it doesn't change anything because even if I do so it will not affect power point presentation. Power Point Charts are linked to excel, and as I checked: deleting legend enteries in Excel file will not affect linked charts in PowerPoint (checked on Office 2010).

What I would like to do is some macro which will check each slide, each chart. And if there is a blank data entry delete it's legend entry.



Here is how I would like to change my graphs:
Before
After


I think something like that will make it, however I do not know VBA for PowerPoint.

Code:
Sub MacroDeletingLegendEnteries()

Dim ppt As Presentation
Dim s As Slide
Dim ch As Chart

'Count from slide one to last slide
For i=1 to ppt.Slides.Count

	'Count from chart one to last chart on this slide
	For x=1 to <last chart on this slide>

		'Take any action only if chart has legend - there are some charts which don't need it
		If <chart has a legend> Then

			'Count from series 1 to last one
			For z=1 to <Number of data series on slide>
				
				'If the legend entry does not exist, then delete it legend entry on chart
				If <Data series z = 0 (there isn't any data on graph)> Then
					<Delete Legend entry number z>
				End If
			Next z

		End if
	
	Next x


Next i



End Sub

Thank you very much for any help with <> entries .
Reply With Quote
  #2  
Old 06-06-2015, 02:07 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,767
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

This is "top of head" code so treat with care. Alco it may nor work if the chart is linked to Excel.

Code:
Sub DeleteZero()
Dim m 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
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasChart Then
Set ocht = oshp.Chart
If ocht.HasLegend Then
For m = ocht.SeriesCollection.Count To 1 Step -1
    a = ocht.SeriesCollection(m).Values
    For L = 1 To ocht.SeriesCollection(m).Points.Count
        If a(L) <> 0 Then b_val = True
    Next L
   If Not b_val Then ocht.Legend.LegendEntries(m).Delete
   b_val = False
Next m
End If 'legend
End If ' chart
Next oshp
Next osld
End Sub
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #3  
Old 06-06-2015, 01:12 PM
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

Thank you very much!

It is almost working. However I found a way in which power point charts are really misleading (attached file).

As you can see your macro works great on second slide, but on first it is mislead.
It's about legend order. On first slide it's "upside down" in excel meaning, on second one it's ok.

On first slide it is counting the opposite way (it should left "e" which is 5th from the beggining, instead it does not delete "l" which is 5th but from the end).

So to make it automatic, macro need to check the order. If the order is "upside down" it should take "upside down" legend entry and delete it .



Changing:
Code:
If Not b_val Then ocht.Legend.LegendEntries(m).Delete
Into:

Code:
If <Legend Enteries has appropriate order> Then

If Not b_val Then ocht.Legend.LegendEntries(m).Delete

Else

If Not b_val Then ocht.Legend.LegendEntries(ocht.SeriesCollection.Count - m + 1).Delete

End if
Do you have and idea, how to check Legend Order?


Of course it is possible to change Legend into "under chart" in each before starting macro, but then on some macro should reverse it and on some not so it would be difficult this way .
Attached Files
File Type: pptx Macro_legends_test.pptx (80.3 KB, 7 views)
Reply With Quote
  #4  
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,767
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

You can check the position which probably determines the order.

example

If ocht.Legend.Position <> xlLegendPositionBottom Then
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #5  
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

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 10:27 AM.


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