Я пытаюсь перебрать гистограмму и сделать любые значения выше 2 красным. Приведенный ниже код в настоящее время работает, но я хочу обойти, используя .Activate

Sub Works()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim x As Integer

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)

    With ws
        .ChartObjects("Chart 1").Activate
        For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
            If ActiveChart.SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
                'If above 2 make Red
                ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                'If below or equal to 2 make Blue
                ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With
End Sub

Это было мое предлагаемое решение, но я получаю ошибку времени выполнения 438, когда пытаюсь запустить цикл For. Я предполагаю, что это просто синтаксическая ошибка, но я не могу понять, как это сделать без .Activate

Sub Fails()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim x As Integer

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)

    With ws.ChartObjects("Chart 1")
        For x = 1 To .SeriesCollection(1).Points.Count
            If .SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
                'If above 2 make Red
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                'If below or equal to 2 make Blue
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With
End Sub
1
BerticusMaximus 24 Апр 2017 в 18:55

2 ответа

Лучший ответ

Причина вашей ошибки уже описана вам @ A.S.H в комментариях к вашему сообщению. Series является свойством ChartObject.Chart, а не ChartObject.

Попробуйте приведенный ниже код, чтобы воспользоваться преимуществами диаграмм VBA, определив следующие типы переменных:

Dim ChtObj As ChartObject
Dim Ser As Series
Dim SerPoint As Point

< Сильный > Код

Option Explicit

Sub Fails()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim ChtObj As ChartObject
    Dim Ser As Series
    Dim SerPoint As Point

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)
    Set ChtObj = ws.ChartObjects("Chart 1") '<-- set chart object

    With ChtObj
        Set Ser = .Chart.SeriesCollection(1)
        For Each SerPoint In Ser.Points
            If SerPoint.DataLabel.Caption > 2 Then 'If above 2 make Red
                SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else 'If below or equal to 2 make Blue
                SerPoint.Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next SerPoint
    End With

End Sub
2
Shai Rado 24 Апр 2017 в 16:23

Как отмечено в комментарии А.С.Х., .Chart - способ сделать это. Тем не менее, вы также можете объявить диаграмму как chartObject и использовать With myChart.chart, чтобы получить бонусы от раннего связывания.

Option Explicit

Sub Fails()

    Dim ws          As Worksheet
    Dim myChart     As ChartObject
    Dim x           As Long

    Set ws = ThisWorkbook.Worksheets(1)
    Set myChart = ws.ChartObjects("Chart 2")

    With myChart.chart

        For x = 1 To .SeriesCollection(1).Points.Count
            'I have changed a bit the line below, as far as I could not achieve what were you doing...---v
            If CLng(.SeriesCollection(1).Name) > 2 Then
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With

End Sub
2
Vityata 24 Апр 2017 в 16:22