Excel VBA操作图表数据标签的一个问题
Private Sub Workbook_Open()
On Error Resume Next
Sheet1.ChartObjects(1).Activate
Dim c%
c = ActiveChart.SeriesCollection.Count
For i = 1 To c
pc = ActiveChart.SeriesCollection(i).Points.Count
For j = 1 To pc
r = Round(Sheet1.Cells(i + 1, 8 + j) * 100, 2)
set p=ActiveChart.SeriesCollection(i).Points(j)
p.DataLabel.Format.TextFrame2.TextRange.Font.Size = 12
p.DataLabel.Format.TextFrame2.TextRange.Font.Bold = msoTrue
If (i = c) Then 'total
p.DataLabel.Formula= ActiveChart.SeriesCollection(i).Points(j).DataLabel.Text & "," & IIf(r > 0, " +" & Format(CStr(r), "0.##"), " " & Format(CStr(r), "0.##")) & "%"
p.DataLabel.Position = xlLabelPositionAbove
findex = InStr(p.DataLabel.Formula, ",") 'the index of ","
lens = Len(p.DataLabel.Formula) - findex 'the len from the index of "," to the end of the text
p.DataLabel.Format.TextFrame2.TextRange.Characters(1, findex - 1).Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
If (r >= 0) Then
p.DataLabel.Format.TextFrame2.TextRange.Characters(findex + 1, lens).Font.Fill.ForeColor.RGB = RGB(0, 128, 0)
Else
p.DataLabel.Format.TextFrame2.TextRange.Characters(findex + 1, lens).Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
End If
Next
Next
End Sub
