删除图表时删除用于图表系列的命名范围

Question

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

我正在寻找一种在删除图表时删除 USED 命名范围的方法。我想过图表“删除”事件，但我找不到任何关于它的信息（它甚至存在吗？？？）。 第二个问题是如何确定图表系列使用了哪些范围？删除命名范围很容易，但如何真正确定图表系列中使用了哪些范围？

非常感谢所有帮助。抱歉，我无法为您提供任何代码，因为我不知道如何设置

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

请确认它是否按您的需要工作