I'm attempting to get the trend line equation from the first series in my chart to a shape text box placed elsewhere on the worksheet - however, I can only get the textbox to populate correctly when I'm stepping through the code line by line - during run-time it has no effect:
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 Note that slopetextboxes is an array containing the names of ~6 shape text boxes.
As far as I know there's no way to get the trend line data label without stopping to display it. I've tried storing it in a string first, DoEvents, and turning Application.ScreenUpdating back on, all to no avail. I'm stumped here.
EDIT: It appears that by placing DoEvents after .DisplayEquation = True I'm able to have some of my shapes populate correctly, but not all. Still appears to be some kind of run-time issue.
BOUNTY EDIT: I've moved ahead to grab the slopes with a formula ran into the data itself, but I still don't understand why I can't grab the chart's .DataLabel.Text during run-time. I can grab it when stepping through, not during run-time. It appears to just take the PREVIOUS series slope and place it in the shape (or a cell, it doesn't even matter where the destination is). DoEvents placed in different spots yields different outcomes, so something must be going on.
4 Answers
Answers 1
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.
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 Set myTrendLine = myChartTrendLines(1) myTrendLine.DisplayEquation = True myTrendLine.DataLabel.Delete myChartTrendLines.Add Set myChartTrendLines = myChartSeries.Trendlines Set myTrendLine = myChartTrendLines(1) myTrendLine.DisplayEquation = True txtbox.Object.Text = myTrendLine.DataLabel.Text Next chartObject End Sub 
Answers 2
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
Good luck!
Answers 3
This worked for me - I loop through multiple charts on Sheet1, toggling DisplayEquation and then writing the equation to a textbox/shape on the different worksheet. I used TextFrame2.TextRange but TextFrame worked as well, if you prefer that. I wrote to both a regular text box, as well as a shape, which was probably overkill as the syntax is the same for both.
This gets the trendline equation from the first Series - it sounded like you didn't want to loop through all the Series in the 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 Answers 4
If it works when you step through, but not when it runs then it's an issue with timing and what Excel is doing in between steps. When you step through, it has time to figure things out and update the screen.
FYI,
Application.Screenupdating = Falsedoesn't work when stepping through code. It gets set back toTruewherever the code pauses.
When did you give it a chance to actually do the math and calculate the equation? The answer is that, you didn't; hence why you get the previous formula.
If you add a simple Application.Calculate (in the right spot) I think you'll find that it works just fine.
In addition, why should Excel waste time and update text to an object that isn't visible? The answer is, it shouldn't, and doesn't.
In the interest of minimizing the amount of times you want Excel to calculate, I'd suggest creating two loops.
- The first one, to go through each chart and display the equations
- Then force Excel to calculate the values
- Followed by another loop to get the values and hide the equations again.
' 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 Update:
I added a sample file based on your description of the issue. You can select 4 different options in an ActiveX ComboBox which copies values to the Y-Values of a chart. It shows the trend-line equation below, based on the formula & through copying the value from the chart into a Textbox shape.
Maybe 2016 is different, but it works perfectly in 2013. Try it out...
0 comments:
Post a Comment