excel - 有没有办法从 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 部分格式化为白色。

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

希望对你有帮助!