时间戳

首页 > 解决方案 > 使用 VBA 将数据点格式化为图表中数据的最后一个点的问题

excel - 使用 VBA 将数据点格式化为图表中数据的最后一个点的问题

问题描述

我有这段代码，它将数据标签应用于图表中数据的最终点。我添加了额外的代码（在它下面单独添加），它为最后一点添加了额外的格式。这种额外的格式似乎没有得到应用，我没有收到任何错误。

Sub LastPointLabel2()
  Dim srs As Series
  Dim iPts As Long
  Dim cht As ChartObject
  Dim vYVals As Variant
  Dim vXVals As Variant
  Set ws = ActiveSheet

  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again.", vbExclamation
  Else
    Application.ScreenUpdating = False
  For Each cht In ws.ChartObjects
      Set srs = cht.Chart.SeriesCollection(1)
      With srs
        vYVals = .Values
        'vXVals = .XValues
        ' clear existing labels
        .HasDataLabels = False
        For iPts = .Points.Count To 1 Step -1
          If Not IsEmpty(vYVals(iPts)) Then
            ' add label
            srs.Points(iPts).ApplyDataLabels _
                ShowSeriesName:=False, _
                ShowCategoryName:=False, ShowValue:=True, _
                AutoText:=True, LegendKey:=False
            Exit For
          End If
                        'Reposition label
              If srs.Points(iPts).HasDataLabel Then
                        With srs.Points(iPts).DataLabel
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlTop
                        .ReadingOrder = xlLTR
                        .Position = xlLabelPositionAbove
                        .Orientation = xlHorizontal
                        End With
                    End If
                'Adjust label size and colour
                If srs.Points(iPts).HasDataLabel Then
                With srs.Points(iPts)
                    .MarkerSize = 7
                    .MarkerStyle = xlCircle
                    .MarkerBackgroundColorIndex = 6
                    .MarkerForegroundColorIndex = 1
                End With
                    End If
        Next
      End With
    Next
    ' legend is now unnecessary
    Application.ScreenUpdating = True
  End If
End Sub

这部分似乎没有得到应用

                        'Reposition label
              If srs.Points(iPts).HasDataLabel Then
                        With srs.Points(iPts).DataLabel
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlTop
                        .ReadingOrder = xlLTR
                        .Position = xlLabelPositionAbove
                        .Orientation = xlHorizontal
                        End With
                    End If
                'Adjust label size and colour
                If srs.Points(iPts).HasDataLabel Then
                With srs.Points(iPts)
                    .MarkerSize = 7
                    .MarkerStyle = xlCircle
                    .MarkerBackgroundColorIndex = 6
                    .MarkerForegroundColorIndex = 1
                End With
                    End If

如果我删除Exit For，则上述格式将应用于所有数据点

标签： excelvbaexcel-charts

解决方案

Sub LastPointLabel2()
  Dim srs As Series
  Dim iPts As Long
  Dim cht As ChartObject
  Dim vYVals As Variant
  Dim vXVals As Variant
  Set ws = ActiveSheet

  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again.", vbExclamation
  Else
    Application.ScreenUpdating = False
  For Each cht In ws.ChartObjects
      Set srs = cht.Chart.SeriesCollection(1)
      With srs
        vYVals = .Values
        'vXVals = .XValues
        ' clear existing labels
        .HasDataLabels = False
        For iPts = .Points.Count To 1 Step -1
          If Not IsEmpty(vYVals(iPts)) Then
            ' add label
            srs.Points(iPts).ApplyDataLabels _
                ShowSeriesName:=False, _
                ShowCategoryName:=False, ShowValue:=True, _
                AutoText:=True, LegendKey:=False
            'Reposition label
            If srs.Points(iPts).HasDataLabel Then
                With srs.Points(iPts).DataLabel
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlTop
                    .ReadingOrder = xlLTR
                    .Position = xlLabelPositionAbove
                    .Orientation = xlHorizontal
                End With
            End If
            'Adjust label size and colour
            If srs.Points(iPts).HasDataLabel Then
                With srs.Points(iPts)
                    .MarkerSize = 7
                    .MarkerStyle = xlCircle
                    .MarkerBackgroundColorIndex = 6
                    .MarkerForegroundColorIndex = 1
                End With
            End If
            Exit For
          End If
        Next
      End With
    Next
    ' legend is now unnecessary
    Application.ScreenUpdating = True
  End If
End Sub

推荐阅读