Question

我正在尝试使用宏将趋势线的等式从图形复制粘贴到单元格。我在Selection.copy遇到错误。

Sub Equations()
    'Equations Macro
    'Keyboard Shortcut: Ctrl+e

    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=3
    Range("C56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(2).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("D56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(3).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("E56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(4).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("F56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(5).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("G56").Select
    ActiveSheet.Paste
End Sub

Answer 1

这是在图表的SeriesCollection中循环并从与其中的每个Series相关的趋势线中提取方程的一种方法。如果需要，可以将SeriesCollection的每个实例更改为FullSeriesCollection。

代码

检查相关系列是否至少有一个Trendline-请注意可能有多个。该代码仅处理第一个，但可以轻松修改以遍历多个趋势线。
检查TrendLine是否正在显示其方程式。
将等式的文本“复制”到指定的Range。在这里，Offset会为每个连续的趋势线向右移动1列。在第一次迭代中，B56的偏移量为1列，因此您的方程式出现在C56中。

Sub Equations()
    Dim chrtObj As ChartObject
    Dim i As Integer

    Set chrtObj = Sheets("Sheet1").ChartObjects("Chart 1") ' Change to your sheet name here

    With chrtObj.Chart
        For i = 1 To .SeriesCollection.Count
            If .SeriesCollection(i).Trendlines.Count > 0 Then
                With .SeriesCollection(i).Trendlines(1)
                    If .DisplayEquation Then
                        Sheets("Sheet1").Range("B56").Offset(0, i).Value = .DataLabel.Text ' Change sheet name here as well
                    End If
                End With
            End If
        Next i
    End With

End Sub

单元中的趋势线方程式复制粘贴

1 个答案: