37本目 グラフの色設定

VBA100本ノック 37本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

---

問題

#VBA100本ノック 37本目
棒グラフの最大値と最小値を目立たせたい。
最大値を緑、最小値を赤、データラベルも追加。
データはB2開始で増減に対応し、再実行を考慮してください。
※グラフは棒グラフ作成済です。既定色は随意。
※出来上がりは添付を参照
※シートは任意、グラフはシートに1つだけ

解答

Sub Macro1()
    
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion
    Set rng = Intersect(rng, rng.Offset(1))
    
    ActiveSheet.ChartObjects("グラフ 1").Activate
    ActiveChart.SetSourceData Source:=rng
    ActiveChart.FullSeriesCollection(1).DataLabels.Delete
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192) '一旦グラフを青に変更
        .Transparency = 0
        .Solid
    End With
    
    Dim MAX_val, MIN_val
    Dim rng_val As Range
    Set rng_val = Intersect(rng, rng.Offset(0, 1))
    MAX_val = WorksheetFunction.Max(rng_val)
    MIN_val = WorksheetFunction.Min(rng_val)
    
    Dim i As Long
    For i = 1 To rng_val.Count
        If Cells(i + 1, 2) = MAX_val Then
            Call グラフの色変更とデータラベル(i, RGB(0, 176, 80)) 'グラフを緑
        ElseIf Cells(i + 1, 2) = MIN_val Then
            Call グラフの色変更とデータラベル(i, RGB(255, 0, 0))  'グラフを赤
        End If
    Next i
    
End Sub

Sub グラフの色変更とデータラベル(i As Long, col As Variant)
    
    ActiveChart.FullSeriesCollection(1).Points(i).Select '受け取った番号
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = col '受け取った色
        .Transparency = 0
        .Solid
    End With
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)

End Sub