#1
|
|||
|
|||
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 . |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
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 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 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 . |
#4
|
|||
|
|||
You can check the position which probably determines the order.
example If ocht.Legend.Position <> xlLegendPositionBottom Then |
#5
|
|||
|
|||
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 |
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 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 |