Excel Macro Graph Удаление пустых Легенда ключей

Question

Option Explicit 

Public PlotName As String 
Public PlotRange As Range 

Sub Tester() 
Range("TCKWH.V.1").Select 
AddPlot ActiveSheet.Range("KWH_G_1") 
End Sub 


Sub AddPlot(rng As Range) 
With ActiveSheet.Shapes.AddChart 
PlotName = .Name 
.Chart.ChartType = xlLineMarkers 
.Chart.SetSourceData Source:=Range(rng.Address()) 
.Chart.HasTitle = True 
.Chart.ChartTitle.Text = Range("KWH.G.1") 
.Chart.Axes(xlValue, xlPrimary).HasTitle = True 
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("KWH.G.1") 
End With 
Set PlotRange = rng 
Application.EnableEvents = False 
rng.Select 
Application.EnableEvents = True 
End Sub 


Sub FixPlott(rng As Range) 
Dim n As Long 
With ActiveSheet.Shapes(PlotName) 
    For n = .SeriesCollection.Count To 1 Step -1 
    With .SeriesCollection(n) 
     If PlotName = "" Then 
      .Delete 
     End If 
     End With 
     Next n 
    End With 
    End Sub 
Sub RemovePlot(rng As Range) 
If Not PlotRange Is Nothing Then 
    If Application.Intersect(rng, PlotRange) Is Nothing Then 
     On Error Resume Next 
     rng.Parent.Shapes(PlotName).Delete 
     On Error GoTo 0 
    End If 
    End If 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Application.ScreenUpdating = False 
RemovePlot Target 
     Application.ScreenUpdating = True 
End Sub 

мне нужна помощь с Sub FixPlott. Я пытаюсь удалить его, чтобы удалить Legend-записи в Легендарном ключе. Например, если я выберу Main Campus и South Hall, будут записи пустой легенды для dunblane и greensburg. Id как легенда, чтобы показать выбранные здания.

Answer 1

Здесь у вас есть исправленная версия вашего суб:

Sub FixPlott(PlotName As String) 
    Dim n As Long 
    With ActiveSheet.Shapes(PlotName).Chart 
    For n = .SeriesCollection.Count To 1 Step -1 
     With .SeriesCollection(n) 
      If .Name = "" Then 
       ActiveSheet.Shapes(PlotName).Chart.Legend.LegendEntries(n).Delete 
      End If 
     End With 
    Next n 
    End With 
End Sub 

Я не уверен в точном триггером вы хотите использовать. Поэтому я включил простую строку trigger; если данный SeriesCollection вызывается как trigger, легенда будет удалена.