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

Question

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

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

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

Answer 1

请尝试下一个代码。无法直接提取 USED 命名范围。我使用了一个技巧来从 SeriesCollection 公式中提取范围。然后将它们与名称 RefersToRange.Address 进行比较并删除匹配的名称。它（现在）returns 在匹配的情况下是一个布尔值（仅在立即 Window 中看到它），但不是您的目的所必需的。该代码还删除了无效名称（丢失了它们的引用）。

已编辑：我做了一些研究，恐怕无法创建 BeforeDelete event...它是可以为图表对象创建的事件的枚举，但是缺少这个.我想相信我已经分别找到了解决您问题的方法：

创建一个 class 能够启用 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
创建另一个class能够处理工作簿和工作sheet事件，命名为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
将下一个代码放入标准模块（需要创建一个 classes 数组以便为所有现有的 sheet 嵌入图表启动事件）：

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

请确认它是否如您所愿

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

Delete named ranges used for chart series when deleting the chart

excel

events

vba

named-ranges