VBA: извлечение значения RGB линий на диаграмме с цветами по умолчанию

8
colors excel excel-vba vba

3 ответов

так что это интересно. Я создаю линейную диаграмму, используя все значения по умолчанию, а затем выполняю эту процедуру:

enter image description here

Sub getLineCOlors()
Dim cht As Chart
Dim srs As Series
Dim colors As String
Dim pt As Point

Set cht = ActiveSheet.ChartObjects(1).Chart

For Each srs In cht.SeriesCollection
    With srs.Format.Line
    colors = colors & vbCrLf & srs.Name & " : " & _
            .ForeColor.RGB
    End With

Next

Debug.Print "Line Colors", colors

End Sub

сразу же окно затем отображает:

Line Colors   
Series1 : 16777215
Series2 : 16777215
Series3 : 16777215

но это явно не тот случай. Очевидно, что все они разного цвета. Если вместо .RGB Я .ObjectThemeColor, тогда я вам все 0, который одинаково и явно ложен, наблюдая за диаграммой!

Line Colors   
Series1 : 0
Series2 : 0
Series3 : 0

теперь вот где становится интересно:

If, после создания диаграммы I изменить цвета серии (или даже оставить их без изменений, назначив те же ThemeColors), то функция показывает допустимые RGBs:

Line Colors   
Series1 : 5066944
Series2 : 12419407
Series3 : 5880731

это как если бы Excel (и PowerPoint / etc.) полностью неспособны распознать автоматически присваивается цвета, на линейных графиках. Как только вы назначите цвет, он может прочитать цвет.

Примечание: линейные диаграммы придирчивы, потому что у вас нет .Fill, а .Format.Line.ForeColor (и .BackColor) и IIRC есть некоторые другие причуды, тоже, как вы можете выбрать человека точка и измените цвет заливки, а затем это повлияет на внешний вид предыдущего сегмента строки и т. д...

это ограничено линейными диаграммами? возможно. Мой прошлый опыт говорит "вероятно", хотя я не в позиция сказать, что это ошибка, это, безусловно, кажется ошибкой.

если я выполняю аналогичную процедуру на диаграмме столбцов - снова используя только цвета по умолчанию, которые автоматически назначаются,

Sub getCOlumnColors()

Dim cht As Chart
Dim srs As Series
Dim colors As String
Dim pt As Point

Set cht = ActiveSheet.ChartObjects(2).Chart

For Each srs In cht.SeriesCollection

    With srs.Format.Fill
    colors = colors & vbCrLf & srs.Name & " : " & _
            .ForeColor.RGB
    End With

Next

Debug.Print "Column Colors", colors

End Sub

затем я получаю то, что кажется допустимыми значениями RGB:

Column Colors 
Series1 : 12419407
Series2 : 5066944
Series3 : 5880731

однако: он по-прежнему не распознает действительный ObjectThemeColor. Если я изменюсь .RGB тогда это выводит:

Column Colors 
Series1 : 0
Series2 : 0
Series3 : 0

таким образом, основываясь на этих наблюдениях, есть, конечно, некоторые невозможность доступа к ObjectThemeColor и/или .RGB собственность автоматически-назначен цветовые форматы.

как подтверждает Тим Уильямс, это была ошибка еще в 2005 году, по крайней мере, поскольку она относится к RGB, и, вероятно, эта ошибка перенесена в Excel 2007+ с ObjectThemeColor и т. д... Вряд ли это будет разрешено в ближайшее время, поэтому нам нужно взломать решение :)

ОБНОВЛЕНО РЕШЕНИЕ

объединить два методы выше! Преобразуйте каждую серию из строки в xlColumnClustered, затем запросите свойство color из .Fill, а затем измените тип диаграммы рядов обратно в исходное состояние. Это может быть более надежным, чем попытка использовать последовательную индексацию (которая вообще не будет надежной, если пользователи переупорядочили серию, например, так, что "Series1" находится в индексе 3 и т. д.)

Sub getLineColors()
Dim cht As Chart
Dim chtType As Long
Dim srs As Series
Dim colors As String

Set cht = ActiveSheet.ChartObjects(1).Chart

For Each srs In cht.SeriesCollection
    chtType = srs.ChartType
    'Temporarily turn this in to a column chart:
    srs.ChartType = 51
    colors = colors & vbCrLf & srs.Name & " : " & _
            srs.Format.Fill.ForeColor.RGB
    'reset the chart type to its original state:
    srs.ChartType = chtType
Next

Debug.Print "Line Colors", colors

End Sub
8

вот код, который я использовал в конце концов.

Sub ShowSeries()
Dim mySrs As Series
Dim myPts As Points
Dim chtType As Long
Dim colors As String

With ActiveSheet
    For Each mySrs In ActiveChart.SeriesCollection
        'Add label
        Set myPts = mySrs.Points
        myPts(myPts.Count).ApplyDataLabels ShowSeriesName:=True, ShowValue:=False

        'Color text label same as line color

        'if line has default color
        If mySrs.Border.ColorIndex = -4105 Then
            chtType = mySrs.ChartType
            'Temporarily turn this in to a column chart:
            mySrs.ChartType = 51
            mySrs.DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = _
                mySrs.Format.Fill.ForeColor.RGB
            'reset the chart type to its original state:
            mySrs.ChartType = chtType

        'if line has a color manually changed by user
        Else
            mySrs.DataLabels.Font.ColorIndex = mySrs.Border.ColorIndex
        End If
    Next
End With

End Sub

2

через полдня мне удалось решить эту проблему:

       Sub ......()

       Dim k as Integer
       Dim colorOfLine as Long

       ...............
       .................

       'Loop through each series
       For k = 1 To ActiveChart.SeriesCollection.Count

            With ActiveChart.FullSeriesCollection(k)

                .HasDataLabels = True

                'Put a fill on datalabels
                .DataLabels.Format.Fill.Solid

                'Get color of line of series
                colorOfLine = .Format.Line.ForeColor.RGB

                'Assign same color on Fill of datalabels of series
               .DataLabels.Format.Fill.ForeColor.RGB = colorOfLine

               'white fonts in datalabels
               .DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)

            End With

        Next k
        ..........
        End Sub
0