Удаление записей легенды с пустым названием серии с использованием VBA - PullRequest
3 голосов
/ 07 марта 2019

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

Я использую приведенный ниже код, но в итоге теряю записи легенды для серий, в которых нет пустых имен, и я не уверен, в чем я ошибаюсь? Для справки у меня всего пять серий.

  Sub LegendRemover()
  Dim i As Integer
  Dim chtob As ChartObject
  On Error Resume Next

  Call Open_Results

      Set chtob = ActiveSheet.ChartObjects("Chart 8")
      For i = chtob.Chart.SeriesCollection.Count To 1 Step -1
      If chtob.Chart.SeriesCollection(i).Name = "" Then
          chtob.Chart.Legend.LegendEntries(i).Delete
        End If
      Next i

End Sub

Заранее спасибо!

1 Ответ

3 голосов
/ 08 марта 2019

вот в чем проблема, когда код запускается в первый раз, он работает.

однако, так как вы удалили записи легенды, количество записей легенды больше не соответствует количеству коллекций серий.

вот изображение, скажем, название для серии 2 пустое, до первого запуска ...

series blank legend
1      n     1
2      y     2
3      n     3
4      n     4

после первого запуска, так как легенда 2 была удалена, 3 теперь становится 2.

series blank legend
1      n     1
2      y     2
3      n     3
4      n

при следующем запуске удаляется исходная легенда 3, теперь 2, и так далее ...

series blank legend
1      n     1
2      y     2
3      n
4      n

вместо удаления легенды
вы можете использовать свойство IsFiltered для серии.
если IsFiltered истинно, строка и легенда будут скрыты, но не удалены.
и может быть показано позже, если имя добавляется обратно ...

см. Следующий фрагмент ...

Sub LegendRemover()
  Dim chtob As ChartObject
  Dim seriesLine As series

  Set chtob = ActiveSheet.ChartObjects("Chart 8")
  For Each seriesLine In chtob.Chart.SeriesCollection
    seriesLine.IsFiltered = (seriesLine.Name = "")
  Next seriesLine
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...