[英]Excel VBA chart, show data label on last point only
I want to add data labels to only the final point on my line graph, at the moment I am using the below, which works fine but only if I know what number the final point is.我只想将数据标签添加到我的折线图上的最后一点,目前我正在使用以下内容,这可以正常工作,但前提是我知道最后一点是什么数字。 I've done a lot of searching and found the points(points.count) object in excel help but I can't seem to make it work for me.
我已经做了很多搜索并在 excel 帮助中找到了 points(points.count) 对象,但我似乎无法让它对我有用。 Please can you suggest a way of only showing the last point on my chart or (ideally) all charts on a worksheet.
请您建议一种仅显示我的图表上的最后一点或(理想情况下)工作表上的所有图表的方法。
Sub Data_Labels()
'
' Data_Labels Macro
ActiveSheet.ChartObjects("Menck Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Delete
ActiveSheet.ChartObjects("Menck Chart").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(59).Select
ActiveChart.SeriesCollection(1).Points(59).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.Size = 9
End Sub
Short Answer简答
Dim NumPoints as Long
NumPoints = ActiveChart.SeriesCollection(1).Count
ActiveChart.SeriesCollection(1).Points(NumPoints).ApplyDataLabels
Long Answer长答案
The use of ActiveChart
is vague, and requires the additional step of selecting the chart of interest. ActiveChart
的使用是模糊的,需要额外的步骤来选择感兴趣的图表。 If you specify the chart you are interested in explicitly, your macro will be much more robust and easier to read.如果您明确指定您感兴趣的图表,您的宏将更加强大且易于阅读。 I also recommend either using a
With
block, or creating intermediate variables, since reading ActiveChart.SeriesCollection(1).Points
over and over is painful and clutters your code.我还建议使用
With
块,或创建中间变量,因为ActiveChart.SeriesCollection(1).Points
遍地阅读ActiveChart.SeriesCollection(1).Points
很痛苦,而且ActiveChart.SeriesCollection(1).Points
代码ActiveChart.SeriesCollection(1).Points
。 Try the later method as follows:试试后面的方法,如下:
Dim chartMenck As Chart, menckPoints as Points, menckDataLabel as DataLabel
Set chartMenck = Sheet1.ChartObjects("Menck Chart").Chart
Set menckPoints = chartMenck SeriesCollection(1).Points
menckPoints(menckPoints.Count).ApplyDataLabels
Set menckDataLabel = menckPoints(menckPoints.Count).DataLabel
menckDataLabel.Font.Size = 9
This is nearly half as long as the original and far easier to read, in my opinion.在我看来,这几乎是原版的一半,而且更容易阅读。
Try this.尝试这个。 First it applies datalabels to ALL points, and then removes them from each point except the last one.
首先它将数据标签应用于所有点,然后从除最后一个点之外的每个点中删除它们。
I use the Points.Count - 1
that way the For/Next
loop stops before the last point.我使用
Points.Count - 1
这样For/Next
循环在最后一个点之前停止。
Sub Data_Labels()
'
Data_Labels Macro
Dim ws As Worksheet
Dim cht as Chart
Dim srs as Series
Dim pt as Point
Dim p as Integer
Set ws = ActiveSheet
Set cht = ws.ChartObjects("Menck Chart")
Set srs = cht.SeriesCollection(1)
'## Turn on the data labels
srs.ApplyDataLabels
'## Iterate the points in this series
For p = 1 to srs.Points.Count - 1
Set pt = srs.Points(p)
'## remove the datalabel for this point
p.Datalabel.Text = ""
Next
'## Format the last datalabel to font.size = 9
srs.Points(srs.Points.Count).DataLabel.Format.TextFrame2.TextRange.Font.Size = 9
End Sub
Yet another way in VBA (eg paste as a new hotkey macro in PERSONAL workbook): https://peltiertech.com/Excel/Charts/LabelLastPoint.html VBA 中的另一种方式(例如在个人工作簿中粘贴为新的热键宏): https : //peltiertech.com/Excel/Charts/LabelLastPoint.html
For impatient, with ShowValue:=True:对于不耐烦,使用 ShowValue:=True:
Option Explicit
Sub LastPointLabel()
Dim mySrs As Series
Dim iPts As Long
Dim bLabeled As Boolean
If ActiveChart Is Nothing Then
MsgBox "Select a chart and try again.", vbExclamation, "No Chart Selected"
Else
For Each mySrs In ActiveChart.SeriesCollection
bLabeled = False
With mySrs
For iPts = .Points.count To 1 Step -1
If bLabeled Then
' handle error if point isn't plotted
On Error Resume Next
' remove existing label if it's not the last point
mySrs.Points(iPts).HasDataLabel = False
On Error GoTo 0
Else
' handle error if point isn't plotted
On Error Resume Next
' add label
mySrs.Points(iPts).ApplyDataLabels _
ShowSeriesName:=True, _
ShowCategoryName:=False, _
ShowValue:=True, _
AutoText:=True, LegendKey:=False
bLabeled = (Err.Number = 0)
On Error GoTo 0
End If
Next
End With
Next
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.