关于图表中设置任意数据点标记

zldccmx

ChangeKing7 发表于 2023-3-1 17:21
我好好学学这两种思路 感谢！

1. Option Explicit
   
2. 
   
3. Sub abc()
   
4.     Dim X As ChartObject
   
5.     For Each X In Sheet164.ChartObjects
   
6.         X.Delete
   
7.     Next
   
8.     Dim 图表 As ChartObject, a, Arr, i
   
9. 
   
10.     a = ActiveSheet.Range("a1").End(xlDown).Row
    
11.     Set 图表 = ActiveSheet.ChartObjects.Add(530, 100, 700, 300)
    
12. 
    
13.     With 图表.Chart
    
14.         .SetSourceData Source:=ActiveSheet.Range("A2:b" & a), PlotBy:=xlColumns
    
15.         .ChartType = xlLine
    
16.         .HasLegend = False
    
17.         .Axes(xlValue, xlPrimary).MaximumScale = Excel.Application.WorksheetFunction.Max(ActiveSheet.Range("b:b")) * 1.03  '最大值
    
18.         .Axes(xlValue, xlPrimary).MinimumScale = Excel.Application.WorksheetFunction.Min(ActiveSheet.Range("b:b")) * 0.97  '最小值
    
19. 
    
20.         Arr = Sheet164.UsedRange
    
21.         For i = 2 To UBound(Arr)
    
22.             If Arr(i, 3) <> "" Then
    
23.                 .FullSeriesCollection(1).Points(UBound(Arr) - i + 1).Select
    
24.                 .SetElement (msoElementDataLabelCallout)
    
25.             End If
    
26.         Next
    
27.         With .FullSeriesCollection(1).DataLabels
    
28.             With .Format.TextFrame2.TextRange
    
29.                 .Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
    
30.                 .Font.Size = 16
    
31.             End With
    
32.         End With
    
33.     End With
    
34.     图表.Name = ActiveSheet.Name
    
35. 
    
36.     Set 图表 = Nothing
    
37. End Sub

复制代码