I've seen this question on font properties and it's got me part of the way.
I'm trying to change the font colour. I so far have the following code:
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.Axes(xlValue, xlSecondary).TickLabels.Font.Color = 5855577
This works fine.
What's irritating me is that I have to do this via activating the chart.
Surely there's a better way. If I do either of the following it doesn't work:
Dim cht As ChartObject
Set cht = ActiveSheet.ChartObjects("Chart 2")
cht.Axes(xlValue, xlSecondary).TickLabels.Font.Color = 5855577
'-------------------------
Dim cht As ChartObject, ax As Axes
Set cht = ActiveSheet.ChartObjects("Chart 2")
Set ax = cht.Axes(xlValue, xlSecondary)
ax.TickLabels.Font.Color = 5855577
I generally try to avoid selecting or activating in my code so this is just annoying! Any ideas?
Axes isn't actually a member of a ChartObject, but a member of ChartObject.Chart.
Therefore, you want to access the Axes-collection of ChartObject.Chart
With ActiveSheet.ChartObjects("Chart 1")
.Chart.Axes(xlValue, xlPrimary).TickLabels.Font.Color = vbRed
End with
Why does it work if you activate it first? Well, because ActiveChart actually returns the Chart-object, instead of the ChartObject-object.
In case you're trying to record a macro, the code for filling the text forecolor won't (TextFrame2 object) work due to a bug already reported to Microsoft, so using the code below, you can do it without issue. You can also change the properties according to your needs.
Use this code:
ActiveChart.Axes(xlCategory).TickLabels.Font.Color = RGB(100, 100, 100)
I prefer also to avoid working with ActvieSheet (if possible).
The code below, will set the nested properties under ChartObject for the properties you need, such as Chart.Axes , and later also for TickLabels.
Code
Option Explicit
Sub Chart_AutoSetup()
Dim ChtObj As ChartObject, ax As Axis, T2 As TickLabels
Dim ShtCht As Worksheet
' change "Chart_Sheet" to your sheet's name (where you have your chart's data)
Set ShtCht = Worksheets("Chart_Sheet") ' <-- set the chart's location worksheet
Set ChtObj = ShtCht.ChartObjects("Chart2") '<-- set chart object
With ChtObj
Set ax = .Chart.Axes(xlValue, xlSecondary) '<-- set chart axes to secondary
Set T2 = ax.TickLabels '<-- set Ticklables object
T2.Font.Color = 5855577
T2.Font.Italic = True ' <-- just another property you can easily modify
End With
End Sub
Related
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.
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
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!
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
I've written this off as a bug - The only workaround was discovered by BrakNicku which is to Select the DataLabel before reading its Text property:
srs.Trendlines(1).DataLabel.Select
Not a sufficient solution (since this can cause some issues during run-time), but the only thing that works.
I had a similar issue running the code below and my solution was to run Application.ScreenUpdating = True between setting the trendline and querying the DataLabel. Note that screen updating was already enabled.
'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
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 = False doesn't work when stepping
through code. It gets set back to True wherever 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...
Shape Text Box Example.xlsm
I am generatig a Pivot table and a 100 stacked column Chart by VBA.
I want to Change the Y axis value from percentage to absolute numbers.
I recorded macros and used the below line.
.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "Standard"
while, i am using this line, I get an run time error
Automation error or unspecified error.
I researched and found there can be a Chance I am missing a reference, but i am struck which reference to add and how to sort this Problem. Below is the code i am using to generate Chart from Pivot.
Sub chart()
Dim sh As Shape
If ActiveSheet.PivotTables.Count = 0 Then Exit Sub
Set ptable = ActiveSheet.PivotTables(1)
Set ptr = ptable.TableRange1
Set sh = ActiveSheet.Shapes.AddChart
sh.Select
With ActiveChart
.SetSourceData ptr
.ChartType = xlColumnStacked100
.Axes(xlValues).Select
selection.Ticketlabels.Numberformat =" Standard"
End With
End Sub
Also, it should be xlValue, not xlValues. And it looks like you have a space at the beginning of your specified format. Try...
.Axes(xlValue).TickLabels.NumberFormat = "Standard"
The saga of the steel plate calculator continues. All the calculations work really well, to no small extent thanks to you lot here on SO, but in the final export stage I find that the graph showing utilisation optimisation loses its data if the source file is no longer open.
I'm looking, then, for a way to keep the graph static after export, ideally without having to copy the data fields across. The ideal would be to convert it into a picture, maintaining its location and size.
I found this here on SO, but it creates a new graph shape, apparently formatted as a pie chart:
Sub PasteGraph2()
Dim ws As Worksheet
Dim cht As Chart
Set ws = ActiveSheet
Set cht = ws.Shapes.AddChart.Chart
With cht
.SetSourceData ws.Range("$B$21:$C$22")
.ChartType = xl3DPie
.ChartArea.Copy
End With
ws.Range("A2").PasteSpecial xlPasteValues
cht.Parent.Delete
End Sub
I also tried this, found on a site of Powerpoint macros and modified to fit, but unsurprisingly it doesn't work in Excel ("ppPastePNG - variable not defined").
Sub PasteGraph1()
' PasteGraph Macro
Dim oGraph As Shape
Dim oGraphPic As Shape
Dim dGrpLeft As Double
Dim dGrpTop As Double
oGraph = ActiveSheet.ChartObjects("Chart 3").Copy
dGrpLeft = oGraph.Left
dGrpTop = oGraph.Top
oGraph.Copy
ActiveSheet.Shapes.PasteSpecial DataType:=ppPastePNG
Set oGraphPic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
oGraph.Delete
oGraphPic.Left = dGrpLeft
oGraphPic.Top = dGrpTop
End Sub
The latter (PasteGraph1) seems to suit my purposes better, but how do I make it work? Is there a simpler way?
ppPastePng is a vba Variable for PowerPoint, so it is not defined in VBA for Excel.
This should work :
ActiveSheet.ChartObjects("Chart 3").Chart.CopyPicture xlScreen, xlBitmap
ActiveSheet.Paste
(Added as answer for completeness, accepted #ZwoRmi's answer because it seems churlish not to given that his suggestion proved vital to making it work...)
Many thanks to #ZwoRmi for the key to solving this - here is the code I ended up using, which is a combination and tweak of the original PasteGraph1 approach and #ZwoRmi's much more useful copy method.
Sub PasteGraph1()
' Converts live graph to static image
Dim oGraphPic As Shape
Dim dGrpLeft As Double
Dim dGrpTop As Double
dGrpLeft = ActiveSheet.ChartObjects("Chart 1").Left
dGrpTop = ActiveSheet.ChartObjects("Chart 1").Top
ActiveSheet.ChartObjects("Chart 1").Chart.CopyPicture xlScreen, xlBitmap
ActiveSheet.Paste
ActiveSheet.ChartObjects("Chart 1").Delete
Set oGraphPic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
oGraphPic.Left = dGrpLeft
oGraphPic.Top = dGrpTop
End Sub
Say I have created a chart in one function as shown:
Sub CreateChart()
Dim sh As Worksheet
Dim chrt as Chart
Set sh = ActiveWorkbook.Worksheets("Sheet1")
Set chrt = sh.Shapes.AddChart.Chart
End Sub
How can I activate this chart in a different function where I want to move it to a certain cell? I am using the following code but it keeps giving me errors and won't activate the chart. I even gave the chart a Title and tried to use it's title t activate it but it won't recognize the name:
Sub MoveChart()
ActiveSheet.ChartObjects("chrt").Activate
With ActiveChart.Parent
.Left = Range("N2").Left
End With
Why activate it? You may use directly the chrt object that you stored, which you may pass to a parametrized MoveChart subroutine:
Sub MoveChart(ByVal chrt As Excel.Chart)
With chrt.Parent
.Left = Range("N2").Left
End With
End Sub
with the difference that now you may move any chart you'd like.
Later edit
The second macro fails because the chart remains unnamed. Trying to access the chart by the name of the VBA variable doesn't do the trick. So, try this:
Sub CreateChart()
Dim chrt As Shape
With ActiveWorkbook.Worksheets("Sheet1").Shapes
Set chrt = .AddChart()
Let chrt.Name = "New chart"
End With
End Sub
Sub MoveChart()
With ActiveWorkbook.Worksheets("Sheet1")
.ChartObjects("New chart").Left = .Range("N2").Left
End With
End Sub
Don't forget to modify the code to use other chart names, other sheet names etc.
I'm trying to insert a chart into a worksheet that would display information from 4 columns.
The x-axis has the dates and the y-axis would have a $ figure amount.
This is what I've gotten from recording a macro (which shows what I want at least):
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "=""target"""
ActiveChart.SeriesCollection(1).XValues = "=MacroParty!$R$4:$R$55"
ActiveChart.SeriesCollection(1).Values = "=MacroParty!$S$4:$S$55"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""current"""
ActiveChart.SeriesCollection(2).XValues = "=VA05NDump!$G$2:$G$833"
ActiveChart.SeriesCollection(2).Values = "=VA05NDump!$P$2:$P$833"
The problem is that this just plops a chart int he middle of the sheet and I'm looking to have it in a specific location.
I'm guessing there's a way nicer way of writing this but I am new to VBA and relying on the brute force method.
Any help would be greatly appreciated!
OK you can clean this up a bit. The macro recorder is great because it can help you see what you need to do, but it is little more than simply replicating key-strokes or mouse-clicks, and the point of programming in VBA should be to work directly with the objects -- much more efficiently than mimicking keystrokes.
I will show some examples of using variables to make your code more concise and hopefully easier to interpret. I'll comment it for you so you can see what I'm doing, and why.
Sub Test()
Dim cObj As Shape 'A Shape container for the Chart
Dim cht As Chart 'Variable will represent the chart
Dim srs As Series 'Variable will represent series
Set cObj = ActiveSheet.Shapes.AddChart '##cObj will refer to this shape
Set cht = cObj.Chart '## cht will refer to this chart
'(Now, the variable "cht" will refer to this specific chart until/unless
' you assign it to another chart.
'## Set the chart type:
cht.ChartType = xlXYScatterSmoothNoMarkers
'## To manipulate the chart's size and location you can use
' something like this to align it with a cell
' there are also Height, Top, Left, Width, etc.
cObj.Top = Range("A1").Top
cObj.Left = Range("A1").Left
'## To manipulate it's size, you can work with
' there are also Height, Top, Left, etc. properties, etc.
cObj.Width = 500
cObj.Height = 300
'## Manipulating the PlotArea, etc.
' there are also Height, Top, Left, etc. properties, etc.
cht.PlotArea.Width = 450
cht.PlotArea.Height = 250
'## Add series to the chart
Set srs = cht.SeriesCollection.NewSeries
srs.Name = "=""target"""
srs.XValues = "=MacroParty!$R$4:$R$55"
srs.Values = "=MacroParty!$S$4:$S$55"
'## "srs" will refer to SeriesCollection(1) until/unless you
' assign it to something else...
'... like now, we want to add another series,
' so we will just assign another NewSeries to the "srs" variable
' and work with the variable srs.
Set srs = cht.SeriesCollection.NewSeries
srs.Name = "=""current"""
srs.XValues = "=VA05NDump!$G$2:$G$833"
srs.Values = "=VA05NDump!$G$2:$G$833"
End Sub