Excel-VBA - Цветная точка оси X, если LIKE * Value * - PullRequest
2 голосов
/ 02 марта 2012

В основном у меня есть диаграмма, которая динамически создается из Java (с использованием POI), и я передаю значения, которые позволят раскрасить определенные точки на диаграмме.

Для этого мне нужно получить доступ к метке значения точки, чтобы я мог проверить, применим ли атрибут условия для значения точки.

Например, у меня установлены переменные для seriesPointObject

  1. Название серии
  2. Имя значения точки
  3. Состояние
  4. Цвет

Мой псевдокод выглядит следующим образом

   For every seriesPointObject in the list
        Get all Values from Obj
        For Each series in the series collection
             Get Every point
                  For every point label
                      Check condition with point value
                          if condition test is true 
                                 series point change colour

Но я не могу получить доступ к метке значения точки для каждой серии. Должна быть связь между меткой значения точки и рядом, но я просто не могу ее найти.

Можно ли как-нибудь получить текст метки точки от объекта серии?

Ответы [ 2 ]

3 голосов
/ 02 марта 2012

Нечто подобное сделает свое дело

Я был немного удивлен, что смог получить доступ к каждому Point каждой серии графиков через VBA, но у Point не было прямого значения. Обходным решением было сбросить весь ряд диаграмм в массив вариантов, проверить каждое значение в массиве для условия, превышающего тест, а затем отформатировать Point с использованием chrSeries.Points(lngCnt)

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X As Variant
    Dim lngCnt As Long
    Set chr = ActiveSheet.ChartObjects(1)
    For Each chrSeries In chr.Chart.SeriesCollection
        X = chrSeries.Values
        For lngCnt = 1 To UBound(X)
            If X(lngCnt) > 10 Then
                With chrSeries.Points(lngCnt)
                    .MarkerBackgroundColor = vbRed
                    .MarkerForegroundColor = vbBlue
                End With
            End If
        Next
    Next
End Sub

sample

2 голосов
/ 04 марта 2012

В приведенном выше примере это работает отлично, однако, что если я захочу проверить по a, b, c и d. сказать: if (pointLabel == "a") {Изменить цвет точки} Я думаю, что в моем вопросе есть небольшая путаница между меткой точки и меткой тика, поскольку я хочу получить доступ к метке на оси x, которая к точке в серии.

Привет, Колин

Чтобы получить доступ к значению данных или метке точки точки данных, необходимо сначала выполнить цикл по каждой точке данных, а затем получить значения.

Дейв уже дал вам метод для получения значений Y. Вот еще один метод, с помощью которого вы можете получить значения X и Y.

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X() As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            pnt.DataLabel.ShowCategoryName = True
            X = Split(pnt.DataLabel.Caption, ",")

            '---- X Value ---------
            '~~> This will give you "A" for the above example
            '~~> which you can use for comparision
            Debug.Print X(0)

            '---- Y Value ---------
            '~~> This will give you 1
            Debug.Print X(1) ' OR

            pnt.DataLabel.ShowCategoryName = False
        Next
    Next
End Sub

EDIT

Приведенный выше код не будет работать, если точки данных не видны. Вы также можете использовать этот код.

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X() As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            '~~> You need this line else the code will fail
            pnt.DataLabel.ShowValue = True

            pnt.DataLabel.ShowCategoryName = True
            X = Split(pnt.DataLabel.Caption, ",")
            pnt.DataLabel.ShowCategoryName = False

            MsgBox "X Value :" & X(0) & vbNewLine & "Y Value :" & X(1)
        Next
    Next
End Sub

1025 ** * Snapshot 1026 ** * 1027

enter image description here

Теперь, если у вас есть значения оси X как " Sid, Rout ", то вышеописанное не будет работать. Для этих сценариев я создал дополнительную функцию. Смотрите код ниже.

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X As String, Y As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            '~~> You need this line else the code will fail
            pnt.DataLabel.ShowValue = True

            pnt.DataLabel.ShowCategoryName = True

            X = GetVal(pnt.DataLabel.Caption, "X")
            Y = GetVal(pnt.DataLabel.Caption, "Y")

            pnt.DataLabel.ShowCategoryName = False

            MsgBox "X Value :" & X & vbNewLine & "Y Value :" & Y
        Next
    Next
End Sub

Function GetVal(DataPointCaption As String, strAxis As String) As String
    Dim TempAr() As String

     TempAr = Split(DataPointCaption, ",")

     If strAxis = "Y" Then GetVal = TempAr(UBound(TempAr))
     If strAxis = "X" Then
        For i = LBound(TempAr) To (UBound(TempAr) - 1)
            GetVal = GetVal & "," & TempAr(i)
        Next i
        GetVal = Mid(GetVal, 2)
     End If
End Function

Snapshot

enter image description here

НТН

Sid

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...