Удалить именованные диапазоны, используемые для серии диаграмм, при удалении диаграммы

Question

Есть ли способ удалить именованные диапазоны, используемые в сериях диаграмм при удалении диаграммы? Я широко использую именованные диапазоны в своей повседневной работе, в том числе и для составления графиков. Когда я создаю диаграммы, я часто называю диапазоны данных и ТОГДА использую их для рядов диаграмм.

Я ищу способ удаления ИСПОЛЬЗОВАННЫХ именованных диапазонов, КОГДА я удаляю диаграмму. Я думал о событии «удалить» графика, но не могу найти какую-либо информацию о нем (существует ли он вообще ???). Второй вопрос - как определить, какие диапазоны были использованы для ряда диаграмм? Удалить названные диапазоны легко, но как на самом деле определить, какие диапазоны были использованы в сериях диаграмм?

Вся помощь приветствуется НАМНОГО. Извиняюсь, но я не могу предоставить вам какой-либо код, так как не знаю, как все настроить

Answer 1

Попробуйте следующий код, пожалуйста. ИСПОЛЬЗОВАННЫЕ именованные диапазоны не могут быть извлечены напрямую. Я использовал трюк для извлечения формул из диапазона SeriesCollection. Затем сравните их с именами RefersToRange.Address и удалите соответствующее имя. Он (сейчас) возвращает логическое значение в случае совпадения (только для просмотра в Immediate Window), но не обязательно для вашей цели. Код также удаляет недопустимые имена (утрата их ссылки).

Отредактировано: я провел некоторые исследования и боюсь, что невозможно создать BeforeDelete event ... Это перечисление событий, способных быть создан для объекта диаграммы, но этот отсутствует. Мне нравится верить, что я нашел решение вашей проблемы, соответственно:

1. Создайте класс, способный включить событие BeforeRightClick. Назовите его CChartClass и напишите следующий код:

   Option Explicit

   Public WithEvents ChartEvent As Chart

   Private Sub ChartEvent_BeforeRightClick(Cancel As Boolean) Dim msAnswer As VbMsgBoxResult msAnswer = MsgBox("Do you like to delete the active chart and its involved Named ranges?" & vbCrLf & _ " If yes, please press ""Yes"" button!", vbYesNo, "Chart deletion confirmation") If msAnswer <> vbYes Then Exit Sub Debug.Print ActiveChart.Name, ActiveChart.Parent.Name testDeleteNamesAndChart (ActiveChart.Parent.Name) End Sub

2. Создайте другой класс, способный обрабатывать события рабочей книги и таблицы, назовите его CAppEvent и скопируйте следующий код:

   Option Explicit

   Public WithEvents EventApp As Excel.Application

   Private Sub EventApp_SheetActivate(ByVal Sh As Object) Set_All_Charts End Sub

   Private Sub EventApp_SheetDeactivate(ByVal Sh As Object) Reset_All_Charts End Sub

   Private Sub EventApp_WorkbookActivate(ByVal Wb As Workbook) Set_All_Charts End Sub

   Private Sub EventApp_WorkbookDeactivate(ByVal Wb As Workbook) Reset_All_Charts End Sub

3. Поместите следующий код в стандартный модуль (необходимо создайте массив классов, чтобы запустить событие для всех существующих встроенных диаграмм листа):

Option Explicit

Dim clsAppEvent As New CAppEvent
Dim clsChartEvent As New CChartClass
Dim clsChartEvents() As New CChartClass

Sub InitializeAppEvents()
  Set clsAppEvent.EventApp = Application
  Set_All_Charts
End Sub

Sub TerminateAppEvents()
  Set clsAppEvent.EventApp = Nothing
  Reset_All_Charts
End Sub

Sub Set_All_Charts()
    If ActiveSheet.ChartObjects.Count > 0 Then
        ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
        Dim chtObj As ChartObject, chtnum As Long

        chtnum = 1
        For Each chtObj In ActiveSheet.ChartObjects
            Set clsChartEvents(chtnum).ChartEvent = chtObj.Chart
            chtnum = chtnum + 1
        Next
    End If
End Sub

Sub Reset_All_Charts()
    ' Disable events for all charts
    Dim chtnum As Long
    On Error Resume Next
     Set clsChartEvent.ChartEvent = Nothing
     For chtnum = 1 To UBound(clsChartEvents)
        Set clsChartEvents(chtnum).ChartEvent = Nothing
     Next ' chtnum
    On Error GoTo 0
End Sub

Sub testDeleteNamesAndChart(strChName As String)
  Dim rng As Range, cht As Chart, sFormula As String
  Dim i As Long, j As Long, arrF As Variant, nRng As Range

  Set cht = ActiveSheet.ChartObjects(strChName).Chart
  For j = 1 To cht.SeriesCollection.Count
    sFormula = cht.SeriesCollection(j).Formula: Debug.Print sFormula
    arrF = Split(sFormula, ",")
    For i = 0 To UBound(arrF) - 1
        If i = 0 Then
            Set nRng = Range(Split((Split(sFormula, ",")(i)), "(")(1))
        Else
            Set nRng = Range(Split(sFormula, ",")(i)) '(1)
        End If
        Debug.Print nRng.Address, matchName(nRng.Address)
    Next i

  ActiveSheet.ChartObjects(strChName).Delete
End Sub

Private Function matchName(strN As String) As Boolean
   Dim Nm As Name, strTemp As String
   For Each Nm In ActiveWorkbook.Names
     On Error Resume Next
        strTemp = Nm.RefersToRange.Address
        If Err.Number <> 0 Then
            Err.Clear
            Nm.Delete
        Else
            If strN = strTemp Then
                Nm.Delete
                matchName = True: Exit Function
            End If
        End If
    On Error GoTo 0
  Next
End Function

Используйте код следующих событий в модуле ThisWorkbook:

Option Explicit

Private Sub Workbook_Open() InitializeAppEvents End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) TerminateAppEvents End Sub

Пожалуйста, подтвердите, что он работал как вам нужно