VBAでフラグの切り替えプログラム

VBA

Excelグラフ切り替え

エクセルフラフが同じシートで切り替えるように表現したい場合がある。複数グラフを見たいときに、マクロを使わないと、複数シートに並べて、グラフを作る必要がある。マクロを使えば、1シートだけで綺麗に見たいグラフを見れるので、管理しやすいです。データ管理も一元管理ができて、別のシートにいろな参照を作成しなくても済む。

実現手段

シートの雛型作成

セルのデータセット

メニュー>データ>データの入力

グラフ用のデータ作成

Excel関数RANDBETWEEN(最小値, 最大値)を利用し、区間は好きに設定すれば良くて、ALLのデータはA,B,C,Dの合計となる。ソース実装では、初回のグラフは手動で作成にして、グラフのオブジェクトを作ってあれば、プログラムが動けるように設計している。

VBAコードの作成

実装は下記の二つ関数となる。細かく説明しないが、調べればなんとなく分かるはずです。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2")) Is Nothing Then
        Exit Sub
    Else
        Call change_graph
    End If
End Sub
Function change_graph()

    Dim chartObj As ChartObject
    Set chartObj = ActiveSheet.ChartObjects(1)
    
    chartObj.Chart.ChartArea.ClearContents
    
    Select Case Range("B2").Value
        Case "ALL"
            With chartObj.Chart
                .ChartType = xlLineMarkers
                .ChartTitle.Text = "ALL"
                .SetSourceData Worksheets("graph").Range("B15:AH15,B16:AH16")
                With .FullSeriesCollection(1).Format.Line
                    .DashStyle = msoLineSolid '実線
                    
                    'https://www.colordic.org/ カラーのRGB設定を参照
                    .ForeColor.RGB = RGB(0, 192, 0) '緑色
                End With
            End With
            
        Case "Graph_A"
            With chartObj.Chart
                .ChartType = xlLine
                .ChartTitle.Text = "Graph_A"
                .SetSourceData Worksheets("graph").Range("B15:AH15,B17:AH17")
                With .FullSeriesCollection(1).Format.Line
                    .DashStyle = msoLineSolid '実線
                    .ForeColor.RGB = RGB(255, 0, 0) '赤色
                End With
            End With
        Case "Graph_B"
            With chartObj.Chart
                .ChartType = xlLine
                .ChartTitle.Text = "Graph_B"
                .SetSourceData Worksheets("graph").Range("B15:AH15,B18:AH18")
                With .FullSeriesCollection(1).Format.Line
                    .DashStyle = msoLineSolid '実線
                    .ForeColor.RGB = RGB(255, 160, 16) 'オレンジ色
                End With
            End With
            
        Case "Graph_C"
            With chartObj.Chart
                .ChartType = xlLine
                .ChartTitle.Text = "Graph_C"
                .SetSourceData Worksheets("graph").Range("B15:AH15,B19:AH19")
                With .FullSeriesCollection(1).Format.Line
                    .DashStyle = msoLineSysDot '点線
                    .ForeColor.RGB = RGB(0, 0, 139) 'DarkBlue
                End With
            End With
                        
        Case "Graph_D"
            With chartObj.Chart
                .ChartType = xlLine
                .ChartTitle.Text = "Graph_D"
                .SetSourceData Worksheets("graph").Range("B15:AH15,B20:AH20")
                With .FullSeriesCollection(1).Format.Line
                    .DashStyle = msoLineSysDot '点線
                    .ForeColor.RGB = RGB(199, 21, 133) '紫色
                End With
            End With
        
        Case "ABCD縦", "ABCD横"
            
            If Range("B2").Value = "ABCD縦" Then
                With chartObj.Chart
                    chartObj.Chart.ChartTitle.Text = "ABCD縦"
                    chartObj.Chart.ChartType = xlColumnStacked
                End With
            Else '"ABCD横"
                With chartObj.Chart
                    chartObj.Chart.ChartTitle.Text = "ABCD横"
                    chartObj.Chart.ChartType = xlBarStacked
                End With
            End If
        
            With chartObj.Chart
                .SetSourceData Worksheets("graph").Range("B15:AH15,B17:AH20")
                With .FullSeriesCollection(1).Format.Fill
                    .ForeColor.RGB = RGB(255, 0, 0) '赤色
                End With
                With .FullSeriesCollection(2).Format.Fill
                    .ForeColor.RGB = RGB(255, 160, 16) 'オレンジ色
                End With
                With .FullSeriesCollection(3).Format.Fill
                    .ForeColor.RGB = RGB(0, 0, 139) 'DarkBlue
                End With
                With .FullSeriesCollection(4).Format.Fill
                    .ForeColor.RGB = RGB(199, 21, 133) '紫色
                End With
            End With
        End Select
        
End Function

コメント

タイトルとURLをコピーしました