时间戳

首页 > 解决方案 > 格式化图表上的数据标签

excel - 格式化图表上的数据标签

问题描述

我写了这个，它删除了 4 个数据标签中的每 3 个，因此更容易阅读。我希望它循环浏览我工作簿中的所有图表，并格式化数据标签的位置，使其略高于折线图。谢谢

Sub ChartTest()

ActiveSheet.ChartObjects("Chart 6").Activate
    z = 1
    With ActiveChart
     If .ChartType = xlLine Then
        i = .SeriesCollection(1).Points.Count
        ActiveChart.FullSeriesCollection(1).DataLabels.Select
        For pts = 1 To i
            ActiveChart.FullSeriesCollection(1).Points(pts).HasDataLabel = True ' Make sure all points are visible data labels
        Next pts
        
        For pts = 1 To i
             ActiveChart.FullSeriesCollection(1).Points(pts).DataLabel.Delete
            z = z + 1
            If z = 4 Then
                z = 1
                pts = pts + 1
           End If
            If pts = i Or pts = 1 Then ActiveChart.FullSeriesCollection(1).Points(pts).HasDataLabel = True ' First & Last point in graph to have a label
        Next pts
    End If
   End With
    
End Sub

标签： excelvba

解决方案

我在四处寻找后决定这样做......

Sub LabelLineGraphs()
    
    On Error Resume Next
    Dim sht As Worksheet
    Dim CurrentSheet As Worksheet
    Dim cht As ChartObject

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set CurrentSheet = ActiveSheet

    For Each sht In ActiveWorkbook.Worksheets
        For Each cht In sht.ChartObjects
            cht.Activate
            For x = 1 To ActiveChart.FullSeriesCollection.Count ' Work through each series
                z = 1
                With ActiveChart
                    If .ChartType = xlLine Then
                        i = .SeriesCollection(x).Points.Count
                        ActiveChart.FullSeriesCollection(x).DataLabels.Select
        
                        For pts = 1 To i
        
                            ActiveChart.FullSeriesCollection(x).Points(pts).HasDataLabel = True ' Make sure all points are visible data labels
            
                            If x Mod 2 = 0 Then  ' Modify label position for each series so they are not in the same place
                                ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Top = ActiveChart.FullSeriesCollection(x).Points(pts).Top - 10 - (x * 5)
                                ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Left = ActiveChart.FullSeriesCollection(x).Points(pts).Left - 10 - (x * 5)
                            Else
                                ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Top = ActiveChart.FullSeriesCollection(x).Points(pts).Top + 10 + (x * 5)
                                ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Left = ActiveChart.FullSeriesCollection(x).Points(pts).Left + 10 + (x * 5)
                            End If
  
                            ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Font.Size = 8
                            If pts = i Then ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Top = 15
                            ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.NumberFormat = "0.00%" ' will need to manually adjust time formats after
                        Next pts
        
                        For pts = 1 To i
                            ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Select
                            ActiveChart.FullSeriesCollection(x).Points(pts).DataLabel.Delete
                            z = z + 1
                            If z = 4 Then
                                z = 1
                                pts = pts + 1
                            End If
                            
                            If pts = i Or pts = 1 Then ActiveChart.FullSeriesCollection(x).Points(pts).HasDataLabel = True ' First Last point in graph to have a label
                        Next pts
                    End If
                End With
            Next x
        Next cht
    Next sht

    CurrentSheet.Activate
    Application.EnableEvents = True

End Sub

推荐阅读