代码之家 › 专栏 › 技术社区 › user23636411

Excel图表:按类别的彩色数据标签-行

label charts vba excel

0

user23636411 · 技术社区 · 2 年前

这是一个后续问题:

Excel Chart: color data labels by categories - columns

以下代码根据排列在两行中的类别和值为图表数据标签上色:

第1行=类别
第2行=值

只要您的类别在第1行,值在第2行,该例程就可以正常工作。

如何使其适用于任意范围的两行,例如第5/6行或第27/28行?

Cells(categoryColorRow, colIndex) 和 Cells(valueColorRow, colIndex) 总是指向第1行和第2行。

你是如何推导的 colIndex 根据图表系列公式?

Sub Labels_SourceROWS_v2()
   Dim p As Point
   Dim CatValueLength As Variant
   Dim dls As DataLabels
   Dim length As Long
   Dim labelItems As Variant
   Dim categoryColorRow As Long
   Dim valueColorRow As Long
   Dim colIndex As Long
   Dim color As Long
   Dim valueText As String
   Dim percentText As String
   Dim startPos As Long
   categoryColorRow = 1
   valueColorRow = 2
   colIndex = 2
   With ActiveChart.SeriesCollection(1)
       .HasDataLabels = True
       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.Name = "Calibri"
           .Font.Size = 10
       End With
       For Each p In .Points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category
               length = Len(labelItems(0))
               color = ActiveSheet.Cells(categoryColorRow, colIndex).Font.color
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               'Value
               color = ActiveSheet.Cells(valueColorRow, colIndex).Font.color
               startPos = startPos + length + 1
               length = Len(labelItems(1))
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

编辑

由FaneDuru解决:

1 回复 | 直到 2 年前

1

2

FaneDuru 2 年前

正如我在上面的评论中所说,您需要从公式中提取序列范围行。请测试以上经过调整的代码:

Sub Labels_SourceROWS_v2()
   Dim p As point, CatValueLength As Variant, dls As DataLabels, length As Long
   Dim labelItems As Variant, categoryColorRow As Long
   Dim valueColorRow As Long, colIndex As Long, color As Long
   Dim valueText As String, percentText As String, startPos As Long
   
   If TypeName(Selection) = "Range" Then MsgBox "You forgot selecting a chart...": Exit Sub

   categoryColorRow = 1
   With ActiveChart.SeriesCollection(1)
       .HasDataLabels = True

       'new code lines exgtracting the necesssary variables value:__
       valueColorRow = Range(Split(.Formula, ",")(2)).row
       categoryColorRow = Range(Split(.Formula, ",")(1)).row
       colIndex = Range(Split(.Formula, ",")(1)).column
       '____________________________________________________________

       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.name = "Calibri"
           .Font.size = 10
        End With
       
       For Each p In .points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(VBA.Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value:
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category:
               length = Len(labelItems(0))
               color = ActiveSheet.cells(categoryColorRow, colIndex).Font.color
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               'Value:
               color = ActiveSheet.cells(valueColorRow, colIndex).Font.color
               startPos = startPos + length + 1
               length = Len(labelItems(1))
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

请在测试后发送一些反馈