删除图表系列使用的命名范围时，删除图表。

Question

当图表被删除时，有什么方法可以删除图表系列中使用的命名范围吗？我在日常工作中广泛使用命名范围，也用于图表制作。当我创建图表时，我经常命名数据范围，然后将它们用于图表系列。

我正在寻找一种方法，当我删除图表时，删除使用过的命名范围。我想过图表 "删除 "事件，但我找不到任何关于它的信息（它是否存在？）。第二个问题是如何确定哪些范围已经被用于图表系列？删除命名的范围很容易，但如何实际确定，哪些范围已被用于图表系列？

所有的帮助都是非常感激的。很抱歉，但我不能为您提供任何代码，因为我不知道如何设置事情

Answer 1

请试下一段代码。USED命名范围不能直接提取。我使用了一个技巧来提取范围，从 SeriesCollection 公式。然后将它们与名字进行比较 RefersToRange.Address 并删除匹配的名称。它（现在）在匹配的情况下返回一个布尔值（只在即时窗口中看到），但对你的目的来说不是必需的。这段代码还删除了无效的名称（失去了它们的引用）。

编辑了。我做了一些研究，我恐怕不可能创建一个 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

4. 使用下一个事件代码在 ThisWorkbook 模块。

   Option Explicit

   Private Sub Workbook_Open()
           InitializeAppEvents
    End Sub

   Private Sub Workbook_BeforeClose(Cancel As Boolean)
           TerminateAppEvents
    End Sub

请确认是否按照你的要求工作