Question

我正在尝试从图表中的第一个系列到位于工作表其他位置的形状文本框获取趋势线方程式-但是，当我单步执行代码时，只能使文本框正确填充逐行-在运行时无效：

For Each chtObj In ActiveSheet.ChartObjects

    Set cht = chtObj.Chart

    For Each srs In chtObj.Chart.SeriesCollection
        srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
        ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
        srs.Trendlines(1).DisplayEquation = False 'Turn it back off
        Exit For
    Next srs

    k = k + 1 ' for the slope textboxes

Next chtObj

请注意，slopetextboxes是一个包含〜6个形状文本框名称的数组。

据我所知，没有停止显示趋势线数据标签的方法。我尝试过先将其存储在字符串DoEvents中，然后再打开Application.ScreenUpdating，但无济于事。我被困在这里。

编辑：通过将DoEvents放在.DisplayEquation = True之后，我可以使一些形状正确填充，但不能填充所有。似乎仍然是某种运行时问题。

赏金编辑：我已经向前移动了一个公式，但该公式本身已进入数据本身，但我仍然不理解为什么我无法获取图表的{ {1}}在运行时。我可以在逐步执行时（而不是在运行时）抓住它。它似乎只是采用PREVIOUS系列坡度并将其放置为形状（或像元一样，甚至在目标位置也不重要）。 .DataLabel.Text放置在不同的位置会产生不同的结果，因此必须进行某些操作。

Answer 1

已更新，以更好地了解该错误。这在excel 2016中对我有效，对源数据（因此对斜率）进行了多次更改

我尝试了myChart.refresh-没有用。我尝试删除然后重新添加整个趋势线，但是也没有用。

这适用于除第一种情况以外的所有情况。第一种情况需要打两次。与.select

相同

如果即使在将趋势线的文本分配给文本框后仍尝试删除该趋势线，则此操作将无效

Option Explicit
Sub main()
Dim ws                                  As Worksheet
Dim txtbox                              As OLEObject
Dim chartObject                         As chartObject
Dim myChart                             As chart
Dim myChartSeriesCol                    As SeriesCollection
Dim myChartSeries                       As Series
Dim myChartTrendLines                   As Trendlines
Dim myTrendLine                         As Trendline

    Set ws = Sheets("MyDataSheet")
    Set txtbox = ws.OLEObjects("TextBox1")

    For Each chartObject In ws.ChartObjects
        Set myChart = chartObject.chart
        Set myChartSeriesCol = myChart.SeriesCollection
        Set myChartSeries = myChartSeriesCol(1)
        Set myChartTrendLines = myChartSeries.Trendlines

        With myChartTrendLines
            If .Count = 0 Then
                .Add
            End If
        End With

        Set myTrendLine = myChartTrendLines.Item(1)

        With myTrendLine
            .DisplayEquation = True
            txtbox.Object.Text = .DataLabel.Text
        End With
     Next chartObject
End Sub

Answer 2

这是我的代码，只要按F5键就可以正常工作：

基本上，我将文本存储在集合中，然后遍历所有文本框以将文本添加到文本框。如果这不是您所要的，那我希望这对您有帮助。

Sub getEqus()
    Dim ws As Worksheet
    Dim cht As Chart
    Dim srs As Variant
    Dim k As Long
    Dim i As Long
    Dim equs As New Collection
    Dim shp As Shape
    Dim slopetextboxes As New Collection

    Set ws = Excel.Application.ThisWorkbook.Worksheets(1)

    'part of the problem seemed to be how you were defining your shape objects
    slopetextboxes.Add ws.Shapes.Range("TextBox 4")
    slopetextboxes.Add ws.Shapes.Range("TextBox 5")

    For Each chtObj In ActiveSheet.ChartObjects
        Set cht = chtObj.Chart

        For Each srs In chtObj.Chart.SeriesCollection
            srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value

            equs.Add srs.Trendlines(1).DataLabel.Text

            srs.Trendlines(1).DisplayEquation = False 'Turn it back off
        Next srs

    Next chtObj


    For i = 1 To slopetextboxes.Count

        'test output i was trying
        ws.Cells(i + 1, 7).Value = equs(i)
        slopetextboxes(i).TextFrame.Characters.Text = equs(i)
    Next
End Sub

当我按下按钮时输出的图像

祝你好运！

Answer 3

这对我有用-我在Sheet1上循环浏览多个图表，切换DisplayEquation，然后将等式写入不同工作表上的文本框/形状。我使用了TextFrame2.TextRange，但如果您愿意，TextFrame也可以使用。我同时写了一个普通的文本框和一个形状，这可能是过大的，因为两者的语法都相同。

这从第一个Series获取趋势线方程-听起来您不想遍历Series中的所有SeriesCollection。

Sub ExtractEquations()
    Dim chtObj As ChartObject
    Dim slopeTextBoxes() As Variant
    Dim slopeShapes() As Variant
    Dim i As Integer

    slopeTextBoxes = Array("TextBox 1", "TextBox 2", "TextBox 3")
    slopeShapes = Array("Rectangle 6", "Rectangle 7", "Rectangle 8")

    For Each chtObj In ThisWorkbook.Sheets("Sheet1").ChartObjects

        With chtObj.Chart.SeriesCollection(1).Trendlines(1)
            .DisplayEquation = True
            ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeTextBoxes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
            ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeShapes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
            .DisplayEquation = False
            i = i + 1
        End With
    Next chtObj
End Sub

Answer 4

我已将其记录为一个错误-BrakNicku发现了唯一的解决方法，即在读取Select属性之前先DataLabel Text：

srs.Trendlines(1).DataLabel.Select

不是一个足够的解决方案（因为这可能会在运行时引起一些问题），但是唯一有效的方法。

Answer 5

在运行下面的代码时，我遇到了类似的问题，我的解决方案是在设置趋势线和查询DataLabel之间运行Application.ScreenUpdating = True。请注意，屏幕更新已启用。

    'Set trendline to the formal y = Ae^Bx
    NewTrendline.Type = xlExponential
    'Display the equation on the chart
    NewTrendline.DisplayEquation = True
    'Add the R^2 value to the chart
    NewTrendline.DisplayRSquared = True
    'Increse number of decimal places
    NewTrendline.DataLabel.NumberFormat = "#,##0.000000000000000"
    'Enable screen updating for the change in format to take effect otherwise FittedEquation = ""
    Application.ScreenUpdating = True
    'Get the text of the displated equation
    FittedEquation = NewTrendline.DataLabel.Text

Answer 6

如果它在您逐步执行时有效，但在运行时无效，则这是时间问题以及Excel在各步骤之间的作用。当您逐步执行时，就有时间找出问题并更新屏幕。

仅供参考，踩到Application.Screenupdating = False无效通过代码。无论代码暂停到哪里，它都会重新设置为True。

您何时给它一次机会来进行数学运算和计算方程式？答案是，您没有。因此为什么要使用以前的公式。

如果您添加一个简单的Application.Calculate（在正确的位置），我认为您会发现它工作正常。

此外，为什么Excel应该浪费时间并将文本更新为不可见的对象？答案是，不应该，也不应该。

为了最大程度地减少您希望Excel计算的时间，我建议创建两个循环。

第一个浏览每个图表并显示方程式
然后强制Excel计算值
接着是另一个循环以获取值并再次隐藏方程式。

' Display the labels on all the Charts
For Each chtObj In ActiveSheet.ChartObjects
    Set cht = chtObj.Chart
    For Each srs In chtObj.Chart.SeriesCollection
        srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
        ' I take issue with the next line
        ' Why are you creating a loop, just for the first series?
        ' I hope this is just left over from a real If condition that wan't included for simplicity
        Exit For
    Next srs
Next chtObj

Application.ScreenUpdating = True
Application.Calculate
Application.ScreenUpdating = False

' Get the Equation and hide the equations on the chart
For Each chtObj In ActiveSheet.ChartObjects
    Set cht = chtObj.Chart
    For Each srs In chtObj.Chart.SeriesCollection
        ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
        srs.Trendlines(1).DisplayEquation = False 'Turn it back off
        Exit For
    Next srs
    k = k + 1 ' for the slope textboxes
Next chtObj
Application.ScreenUpdating = True

更新：

我根据您对问题的描述添加了一个样本文件。您可以在ActiveX组合框中选择4个不同的选项，将值复制到图表的Y值。它根据公式＆通过将图表中的值复制到文本框形状中，显示了下面的趋势线方程式。

也许2016年会有所不同，但在2013年可以完美运行。尝试一下...

Shape Text Box Example.xlsm

将一系列趋势线方程式获取到形状文本框

6 个答案:

更新：