2 
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 的帮助。我试图让它删除图例键上的图例条目。例如，如果我选择 Main Campus 和 South Hall，则会有 dunblane 和 greensburg 的空白图例条目。我喜欢这个传说只是为了展示选定的建筑物。

4

1 回答 1

2

在这里，您有一个更正版本的子：

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 被调用 like trigger，则图例将被删除。

于 2013-06-27T18:14:39.253 回答