Power Point

PowerPoint_VBA · #1 06-06-2015, 12:07 AM

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

.

JohnWilson · #2 06-06-2015, 02:07 AM

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

PowerPoint_VBA · #3 06-06-2015, 01:12 PM

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

.

JohnWilson · #4 06-07-2015, 12:22 AM

You can check the position which probably determines the order.

example

If ocht.Legend.Position <> xlLegendPositionBottom Then

PowerPoint_VBA · #5 06-07-2015, 06:46 AM

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

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 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