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 についてサポートが必要です。Legend Key の Legend Entries を削除しようとしています。たとえば、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 が のように呼び出された場合trigger、凡例は削除されます。

于 2013-06-27T18:14:39.253 に答える