Getting a series trend line equation to a shape text box

Updated with better understanding of the bug. This works for me in excel 2016 with multiple changes to the source data (and therefore the slope)

I tried myChart.refresh - didnt work. I tried deleting and then re-adding the entire trendline, also didnt work.

This works for everything but the first case. First case needs to be hit twice. Same as for .select

If you try and delete trendline even after assigning its text to textbox, this wont work

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

enter image description here

enter image description here


Here's my code that seems to definitely work when just pressing F5:

Basically, I store the text in a collection, then iterate through all of the textboxes to add the text to the textboxes. If this wasn't precisely what you were asking for, then I hope this helps in any way.

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

Pictures of what the output looks like when i just press the button

Before

After

Good luck!

Tags:

Excel

Vba