Is there a way to add a callout label to a point i

问题:

Is there a way to add a callout label to a point in a chart, without using Select?

Recording a macro, I got this:

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

But I would rather like to avoid using Select. I tried simply using the SetElement-method on the point, but that failed. Using the HasDataLabel = True-method simply adds a datalabel.

Is there any workarounds to selecting the point and then using SetElement on the chart, or will I have to settle for something resembling the above macro?

回答1:

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

Feel free to play with .AutoShapeType property. You can also format the data label to show the values in whatever 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

回答2:

As I said in a comment: I couldn't find a way to do this directly but thought I'd be able to work around it.

Turns out I was unsuccessful!

But let's cover an edge case which for some uses will have a pretty easy solution; say you don't need datalabels except for the instances where you want callout:

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 anyone desperate, the closest I came was to create an overlay using the original chart as a template. It doesn't work accurately for arbitrary charts, however, due to positioning issues with the callout box.

But at this point, you might as well have just added a textbox or something far less involved than copying a chart, deleting half its contents and making the rest of it invisible...

But for the sake of Cthul-- 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 intact with only 1 point having callout.

回答3:

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

There is an option "manual label" which seems to be very close to what you want. I am using the version of 1996-97 which has visible VBA code. I have not checked if the latest version has.

回答4:

try the below code

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