vba - Excel 宏图删除空白图例键

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 方面的帮助。我试图让它删除图例键上的图例条目。例如，如果我选择主校区和南厅，则会有邓布兰和格林斯堡的空白图例条目。我希望图例只是为了显示选定的建筑物。

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一样被调用，图例将被删除。