I am trying to set the data-label properties of a data point using this code snippet, but for some reason the properties are not being set as intended. [ Please see the pic for better clarity ].
A workaround could be using the Reset label Text [ See Pic - 2 ] thus forcing the data-label to update the set properties. But I couldn't find the vba equivalent of the same. Help.
'This is happening inside a loop
Dim thisbarpoint As Point
Set thisbarpoint = thischart.FullSeriesCollection(ibar).Points(jbar)
thisbarpoint.DataLabel.ShowCategoryName = True
thisbarpoint.DataLabel.ShowValue = False
thisbarpoint.DataLabel.ShowSeriesName = False
Debug.Print thisbarpoint.DataLabel.caption
Dim DataLabelCaption As String
DataLabelCaption = thisbarpoint.DataLabel.caption
Debug.Print DataLabelCaption 'This gives the value as 26.7%
PIC-1:
PIC-2:
This worked fine for me:
Dim cht As Chart, s As Series
Set cht = ActivePresentation.Slides(1).Shapes(1).Chart
Set s = cht.SeriesCollection(1)
Debug.Print s.HasDataLabels 'False
s.HasDataLabels = True
With s.DataLabels
.ShowCategoryName = True
.ShowValue = False
.ShowSeriesName = False
End With
We can't know if your file is corrupted, or if the problem is elsewhere in code you didn't include.
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
Using the below code i get a 424 error "Object Required" on the .AddPicure line as indicated. I'm unsure as to why as pic is dimensioned as object, and the .addpicture comand looks fully referenced to me.
Apologies for the length of code, i thought it best to leave in all variables.
I'm using Excel 13 from MS Visio 16, and late binding is necessary.
**Edit: Sorry, it is infact an add text box line thats giving me the problem, I've updated the code below...
Sub testexcel()
Dim pic As Object
Dim rng As Object
Dim tWidth As Long, tHeight As Long
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWb = xlApp.workbooks.Open("C:\Users\tom\Desktop\Book1.xlsx")
Set xlWs = xlWb.sheets("Sheet1")
xlApp.ScreenUpdating = False
Set rng = xlWs.Range("B18")
Set rng2 = xlWs.Range("A1", rng.Offset(-1, -1))
picture1 = "C:\Users\tom\Desktop\PX001.bmp"
pHeight = 145
pWidth = 200
tHeight = 10
tWidth = 200
posX = 10
posY = 10
'On Error GoTo ErrMsg
With xlWs.Range("A1", rng.Offset(-1, -1))
'*******Problem on next line*******
Set txtBx = xlWs.Shapes.AddTextbox(msoTextOrientationHorizontal,
txtPosX, txtPosY, tWidth, tHeight).TextFrame.Characters.Text = "FooBar"
End With
'Some other code here...
End Sub
try splitting it up
Set txtBx = xlWs.Shapes.AddTextbox(msoTextOrientationHorizontal, txtPosX, txtPosY, tWidth, tHeight)
txtBx.TextFrame.Characters.Text = "FooBar"
I think this is what's happening:
xlWs.Shapes.AddTextbox(msoTextOrientationHorizontal, txtPosX, txtPosY, tWidth, tHeight).TextFrame.Characters.Text = "FooBar"
This retunrs false because the second = is interpreted as a comparison. Then you are basically doing Set txtBx = False which causes the error.
It could also be that vba tries to assign the Text property which is a string to txtBx.
edit: I would also suggest using Option Explicit. If VBA knows that txtBx is supposed to be a shape, it tells you it got a type mismatch. In this case you got lucky because the Set tells it to expect an object and thus threw an error. If you wanted to assign a string for example, you would have gotten the error at a later line (or no error at all) because you have False where you expect a string which makes debugging more complicated.
I am trying to create a clickable toggle button that hides a year's worth of data if it is currently unhidden and unhides it if it is hidden. I know this syntax is incorrect but I am not sure how to make it work. Any help would be appreciated.
Sub Hide_2012()
Dim Yr2012 As Range
Set Yr2012 = ThisWorkbook.Worksheets("Open Jobs Calculations").Range("AI:AT")
If Yr2012.Visible = False Then
Yr2012.Visible = True
Else If Yr2012.Visible = True Then
Yr2012.Visible = False
End If
This works for me. Apparently hidden only works on entire columns.
Dim Yr2012 As Range
Set Yr2012 = ThisWorkbook.WorkSheets("Open Jobs Calculations").Range("A1:B10") 'change range
If Yr2012.EntireColumn.Hidden = False Then
Yr2012.EntireColumn.Hidden = True
ElseIf Yr2012.EntireColumn.Hidden = True Then
Yr2012.EntireColumn.Hidden = False
End If
Edit per Scott's comment:
Yr2012.EntireColumn.Hidden = Not Yr2012.EntireColumn.Hidden
much more elegant.
This modification of #findwindow's answer worked for me:
Set Yr2012 = ThisWorkbook.Worksheets("Open Jobs Calculations").Columns("AI:AT") ' <- (ie, set range to the desired columns)
then you can still reference the "Yr2012" range, without needing ".EntireColumn":
If Yr2012.Hidden = False Then ...
Just another take on the same idea, to reduce typing :)
I am creating a quiz. It works well for the part I have but is a bit lengthy. The RadioButtons I am using are set at the start through the Properties window. I have a "Reset" CommandButton that I am using to clear the quiz.
' Question Block 1
' THIS method does work
ActiveSheet.OptionButton1.Enabled = True
ActiveSheet.OptionButton2.Enabled = True
ActiveSheet.OptionButton3.Enabled = True
ActiveSheet.OptionButton4.Enabled = True
ActiveSheet.OptionButton1.Value = False
ActiveSheet.OptionButton2.Value = False
ActiveSheet.OptionButton3.Value = False
ActiveSheet.OptionButton4.Value = False
' Question Block 1 (Alternate Method)
' THIS method does NOT work
ActiveSheet.OptionButton1.GroupName = "Q1"
ActiveSheet.OptionButton2.GroupName = "Q1"
ActiveSheet.OptionButton3.GroupName = "Q1"
ActiveSheet.OptionButton4.GroupName = "Q1"
ActiveSheet.OptionButton.GroupName("Q1").Enabled = True
ActiveSheet.OptionButton.GroupName("Q1").Value = False
The first block of code works fine. The second one does not. What am I doing wrong with trying to assign the RadioButtons to a group in this manner? I've tried numerous approaches and most end with error messages saying object does not support this property or method, method or member not found, object required and on and on. Scratching my head. --Edited I am NOT using this in a UserForm. The RadioButtons are just placed on the Excel Sheet.
Found an answer that seems to work really well for my purposes. I was looking to do this by GroupNames property but as long as it works there are a number of ways to solve any problem. Hope someone else can benefit from this code.
' Defines OptionButtons as Objects
Dim OptBtn As OLEObject
' Re-Enables RadioButtons
For Each OptBtn In Sheet1.OLEObjects
If TypeName(OptBtn.Object) = "OptionButton" Then
OptBtn.Object.Enabled = True
End If
Next
' Resets RadioButtons to False (removes the dot)
For Each OptBtn In Sheet1.OLEObjects
If TypeName(OptBtn.Object) = "OptionButton" Then
OptBtn.Object.Value = False
End If
Next
I simply want to add a chart title to my chart using vba. I actually want to do it recursively for every chart in every sheet, but I can't even get 1 chart to work. Here is the code I have:
Dim chnam
chnam = Left(ActiveSheet.Name, (Len(ActiveSheet.Name) - 9))
With ActiveWorkbook.ActiveSheet.ActiveChart
.HasTitle = True
.ChartTitle = chnam
End With
Here is my chart:
When I run my code, I get:
Object does not support this property or method
Try this:
Dim chnam as string
chnam = Left(ActiveSheet.Name, (Len(ActiveSheet.Name) - 9))
With ActiveWorkbook.ActiveSheet.ActiveChart
.HasTitle = True
.ChartTitle.Select
.ChartTitle.Text = chnam
End With
Try changing the code to this:
Dim chnam As String
chnam = Left(ActiveSheet.Name, (Len(ActiveSheet.Name) - 9))
With ActiveWorkbook.ActiveChart
.HasTitle = True
.ChartTitle.Select
.ChartTitle.Text = chnam
End With
...which will work for the active chart, then add a For Each... if you want to apply to all charts in all sheets in the activeworkbook.
I've had the same problem and can't find the answer - but have found something that works. What I mean by that is I don't know why it works but it does.
Try this - worked for me.:
With ActiveWorkbook.ActiveChart
.HasTitle = False // added line - not sure why it works!
.HasTitle = True
.ChartTitle.Text = "Chart Title"
End With
Hope that helps.
The above failed for me in Office 2016. I had to use the Worksheet.Shapes object.
Debug.Assert ActiveWorkbook.Charts.Count = 0 ' Strange, but true
ActiveSheet.Shapes(1).Chart.ChartTitle.Text = chnam
The following subroutine works for me.
' Set title of chart with given name on given worksheet
Private Sub RetitleChart(sheetExport As Worksheet, strChartName As String, strChartTitle As String)
Dim chartOverview As Chart
Set chartOverview = sheetExport.Shapes(strChartName).Chart
chartOverview.ChartTitle.Text = strChartTitle
Set chartOverview = Nothing
End Sub
Another method to set a Chart's Title text is to use the ChartWizard method, thus:
Dim chnam as string
chnam = Left(ActiveSheet.Name, (Len(ActiveSheet.Name) - 9))
ActiveWorkbook.ActiveSheet.ActiveChart.ChartWizard Title:=chnam
It's worthwhile familiarizing yourself with the documentation for this method:
https://msdn.microsoft.com/en-us/library/office/ff838804.aspx
and that of Chart itself:
https://msdn.microsoft.com/en-us/library/office/ff837379.aspx
(Which has a link to the documentation for the ChartTitle object.)
I had the same problem - on my current machine, Excel 2017, while I hadn't had it 6 months ago; having code
pchrTheChart.HasTitle = True
pchrTheChart.ChartTitle.Select
would err on the second line; if I inserted a breakpoint and then resumed with no change, it worked fine.
But, variant on a solution above worked; even though the chart was just created and started out without a title, I have to explicitly turn the title off before turning it on and now it works with no issues every time.
pchrTheChart.HasTitle = False
pchrTheChart.HasTitle = True
pchrTheChart.ChartTitle.Select
Original poster said they didn't know why it worked; answer, to me it seems we're working around a VBA bug, I imagine something to do with null handling.