有没有办法从 Excel VBA 中的轴派生图表？

Question

我有许多用于操作 Excel 图表的通用 VBA 宏（例如，将一个图表叠加在另一个图表之上；重新调整坐标轴；或将自定义曲线（例如“y = x^2 - 1”）添加到图表中在文本框中键入公式）。这些宏是不带任何参数的子程序，我将它们存储在 .xlam 加载项中，并从 Excel 功能区上的链接按钮运行它们。要在特定图表上运行宏，请选择图表，然后单击功能区上的按钮。

为了让宏知道它们在哪个图表上运行，我有一个这样的函数：

Function chart_from_selection() As Chart

  If TypeName(Selection) = "ChartArea" Or TypeName(Selection) = "PlotArea" Then
    Set chart_from_selection = Selection.Parent
  ElseIf TypeName(Selection) = "Series" Then
    Set chart_from_selection = Selection.Parent.Parent
  Else
    MsgBox ("Select a chart!")
  End If

End Function

所以每个宏的前几行是

Dim cht As Chart
Set cht = chart_from_selection()

无论您选择了图表区域、绘图区域还是其中一个系列，宏都会识别图表。

如果您选择了图表轴之一，我也希望它能够工作，但问题是轴对象的父级是工作表而不是图表。有谁知道如何从其轴之一派生图表对象本身？我能想到的唯一方法是记录轴的位置，然后将其与工作表中所有图表的位置进行比较，直到找到并重叠，但这似乎很复杂，我想知道我是否忽略了更简单的方法...

Answer 1

好的，所以我想我可能会为您提供解决方案：

Sub Find_Chart()

Dim C As ChartObject
Dim sAx As Axis
Dim Axs As Object

'Check if selection is axis
If TypeOf Selection Is Axis Then
    Set sAx = Selection
End If

'Loop through charts
For Each C In ActiveSheet.ChartObjects
    'Loop through axes
    For Each Axs In C.Chart.Axes
        If Axs.AxisTitle.Caption = sAx.AxisTitle.Caption Then
            Debug.Print C.Name
        End If
    Next Axs
Next C

End Sub

要使上述代码正常工作，您的图表轴必须都有标题...如果您的图表没有标题（并且您希望保持这种方式），您可以添加标题并将字体更改为白色以保持图表看起来干净。每个标题也必须是唯一的。设计一个 ID 系统以确保所有标题都是唯一的（例如 Chart1AxV、Chart1AxH、Chart2AxV 等）。如果您有预先存在的标题并且有些标题重复，您可以在标题末尾添加一个唯一 ID，并将标签的 ID 部分格式化为白色。

上面的代码循环遍历工作表中的每个图表并检查图表中的每个轴。如果轴标题与所选轴的标题相同，则图表名称将打印到即时窗口。

希望对您有所帮助！

Answer 2

感谢@GSerg 的输入。所以我走了很长的路，通过与轴位置进行比较来找出图表。如果有人感兴趣，这里是代码。它可以通过提供一个轴对象作为显式参数来运行，也可以不带参数但在电子表格中选择一个轴来运行。

不幸的是，轴坐标是相对于图表而不是工作表的，因此该方法不是故障安全的。基本上，它会一张一张地遍历图表，并为每个图表检查其任何轴是否具有与给定轴完全相同的坐标。如果不同图表上的两个轴碰巧与各自图表具有相同的相对位置，则可能会失败。

Function chart_from_axis(Optional ax As Axis) As Chart
' Returns the chart from one of its axes. Necessary because the axis parent is the
' worksheet not the chart

  If ax Is Nothing Then
    If TypeOf Selection Is Axis Then
      Set ax = Selection
    Else
      Exit Function
    End If
  End If

  Dim co As ChartObject
  For Each co In ActiveSheet.ChartObjects
    If axis_belongs_to_chart(ax, co.Chart) = True Then
      Set chart_from_axis = co.Chart
      Exit Function
    End If
  Next co

End Function

Function axis_belongs_to_chart(ax As Axis, cht As Chart) As Boolean

  If axes_coincide(ax, cht.Axes(xlCategory)) = True Or _
     axes_coincide(ax, cht.Axes(xlValue, xlPrimary)) = True Then
    axis_belongs_to_chart = True
  ElseIf cht.Axes.Count = 3 Then
    If axes_coincide(ax, cht.Axes(xlValue, xlSecondary)) = True Then
      axis_belongs_to_chart = True
    End If
  End If

End Function

Function axes_coincide(ax1 As Axis, ax2 As Axis) As Boolean

  If ax1.Top = ax2.Top And ax1.Left = ax2.Left And ax1.Height = ax2.Height _
    And ax1.Width = ax2.Width Then axes_coincide = True

End Function

Answer 3

我修改了上面的方案，将Axis Title改为唯一值，根据唯一值找到图表，然后改回来……返回图表

Function GetChartFromAxis(Axis As Axis) As Chart
Static UniqueIndex As Long
Dim OriginalTitle As String, UniqueName As String
Dim oSheet As Worksheet
Dim oChartObj As ChartObject
Dim oAxis As Axis

    ' Force a Unique Axis Title
    If UniqueIndex > 100000 Then UniqueIndex = 0
    UniqueIndex = UniqueIndex + 1
    UniqueName = "GetChartFromAxis" & UniqueIndex
    If Axis.HasTitle Then
        OriginalTitle = Axis.AxisTitle.Caption
    Else
        Axis.HasTitle = True
    End If
    Axis.AxisTitle.Caption = UniqueName

    ' Find the Axis base on the Unique Title
    Set oSheet = Axis.Parent
    For Each oChartObj In oSheet.ChartObjects
        'Loop through axes
        For Each oAxis In oChartObj.Chart.Axes
            If oAxis.HasTitle Then
                If oAxis.AxisTitle.Caption = UniqueName Then
                    Debug.Print oChartObj.Name
                    Set GetChartFromAxis = oChartObj.Chart
                    Exit For
                End If
            End If
        Next
        If Not GetChartFromAxis Is Nothing Then Exit For
    Next

    ' Reset the Axis Title
    If OriginalTitle <> vbNullString Then
        Axis.AxisTitle.Caption = OriginalTitle
    Else
        Axis.HasTitle = False
    End If
End Function