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

有没有办法从Excel VBA中的轴导出图表？

3 个答案: