Is there a way to add a leader label to a point on a chart without using select?

Is there a way to add a leader label to a point on a chart without using Select ?

A macro record, I got the following:

 Sub Macro9() ActiveSheet.ChartObjects("SPC").Activate ActiveChart.FullSeriesCollection(1).Select ActiveChart.FullSeriesCollection(1).Points(4).Select ActiveChart.SetElement (msoElementDataLabelCallout) End Sub 

But I would prefer not to use Select . I tried just using the SetElement method at this point, but it failed. Using the HasDataLabel = True method , a datalabel is simply added.

Are there any workarounds for selecting a point and then using SetElement on the chart, or will I need to solve something similar to this macro?

+5
source share
4 answers

Is that what you are trying? In the code below, we completely avoided .Activate/.Select :)

Feel free to play with the .AutoShapeType property. You can also format the data label to display the values ​​in any format you want.

 Sub Sample() Dim objC As ChartObject, chrt As Chart, dl As DataLabel Dim p As Point Set objC = Sheet1.ChartObjects(1) Set chrt = objC.Chart Set p = chrt.FullSeriesCollection(1).Points(4) p.HasDataLabel = True Set dl = p.DataLabel With dl .Position = xlLabelPositionOutsideEnd .Format.AutoShapeType = msoShapeRectangularCallout .Format.Line.Visible = msoTrue End With End Sub 

Screenshot

enter image description here

+5
source

As I said in a comment: I could not find a way to do this directly, but I thought I could get around this.

It turns out I was not successful!

But let it cover a boundary case, which for some applications will have a fairly simple solution; let's say you don't need datalabels, unless you want to call:

 Sub chartTest() Dim co As ChartObject Dim ch As Chart Dim i As Integer ' The point index we want shown i = 2 Set co = Worksheets(1).ChartObjects(2) Set ch = co.Chart co.Activate ch.SetElement (msoElementDataLabelCallout) For j = 1 To s.Points.Count ' We can change this to an array check if we want several ' but not all points to have callout If j <> i Then s.Points(j).HasDataLabel = False Next j End Sub 

For those who despaired, the closest I came to create an overlay was using the original diagram as a template. This does not work exactly for arbitrary diagrams, however due to problems with positioning with the leader field.

But at this point you could just add a text box or something much less active than copying a chart, deleting half of its contents and leaving it invisible ...

But for Ktul's sake, I mean science:

 Sub pTest() Dim co As ChartObject Dim ch As Chart Dim s As Series Dim p As Point Set co = Worksheets(1).ChartObjects(1) Set ch = co.Chart Set s = ch.SeriesCollection(1) i = 2 Call copyChartTest(co, ch, i) End Sub Sub copyChartTest(ByRef co As ChartObject, ByRef cht As Chart, ByVal i As Integer) Dim ch As Chart ' The overlay chart Set ch = co.Duplicate.Chart ' Set callout ch.SetElement (msoElementDataLabelCallout) ' Invisibil-ate! With ch .ChartArea.Fill.Visible = msoFalse .SeriesCollection(1).Format.Line.Visible = False .ChartTitle.Delete .Legend.Delete For j = 1 To .SeriesCollection(1).Points.Count .SeriesCollection(1).Points(j).Format.Fill.Visible = msoFalse If j <> i Then .SeriesCollection(1).Points(j).HasDataLabel = False Next j End With ' Align the charts With ch .Parent.Top = cht.Parent.Top .Parent.Left = cht.Parent.Left End With End Sub 

And the result: DataLabels is intact, with only 1 point having a leader.

enter image description here

+3
source

Have you tried this free tool http://www.appspro.com/Utilities/ChartLabeler.htm from Rob Bovey?

There is a “manual shortcut” option, which seems to be very close to what you want. I am using version 1996-97, which has visible VBA code. I did not check if the latest version has.

+1
source

try the code below

 Sub Macro9() ActiveSheet.ChartObjects("SPC").Activate ActiveChart.SeriesCollection(1).Points(4).HasDataLabel = True ActiveChart.SeriesCollection(1).Points(4).DataLabel.Text = "Point 4 Test" End Sub 
0
source

Source: https://habr.com/ru/post/1245551/


All Articles