简体   繁体   English

Excel VBA 图表,仅在最后一点显示数据标签

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM