Excelmacros图删除空白的图例键

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的帮助。 我正试图让它删除图例键上的图例条目。 例如，如果我select主校区和南厅，那么会有空白的邓布恩和格林堡的图例条目。 像传说一样，只是为了显示选定的build筑物。

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 

我不确定你想要使用的确切的触发器。 所以我包含了一个简单的stringtrigger ; 如果给定的SeriesCollection被称为trigger ，图例将被删除。