ガントチャートの作成 エクセルVBA

グラフ

得られる効果

工程表から、

ガントチャートを作成します。

動作条件

オートフィルタでタスクを１つに絞る。その後マクロ実行でガントチャートを作成。

コード

Sub ガントチャート作成()

Line = Cells(Rows.Count, 1).End(xlUp).Row

'グラフの作成
Range("B1", Range("c1").End(xlDown)).Select
ActiveSheet.Shapes.AddChart2(Style:=297, XlChartType:=xlBarStacked, Left:=200, Top:=20, Width:=600, Height:=400).Select
ActiveSheet.ChartObjects(1).Name = "my"

'補助線
ActiveChart.Axes(xlValue).HasMinorGridlines = True
ActiveChart.Axes(xlValue).MinorUnit = 1

'日数の追加（タスクに必要な日数）
Range("D1:D8").Select
Selection.Copy
ActiveSheet.ChartObjects("my").Activate
ActiveChart.Paste

'軸の日付の範囲
ActiveChart.Axes(xlValue).MinimumScale = Range("C2").Value2 - 5
ActiveChart.Axes(xlValue).MaximumScale = Range("E" & Line).Value2 + 5

'データラベル表示
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Position = xlLabelPositionInsideEnd
ActiveChart.Axes(xlValue).MinorGridlines.Select


'色をつけない。
ActiveChart.FullSeriesCollection(1).Select
Selection.Format.Fill.Visible = msoFalse

'軸の反転
ActiveChart.Axes(xlCategory).ReversePlotOrder = True

'グラフタイトル作成
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = Range("A2").Value
    
End Sub

コード改良してみた。

前記のコードは、D2：D8と行を指定しまっているので、改良してみました。

Sub ガントチャート作成()

    Dim ChartObj As Object
    
    Line = Cells(Rows.Count, 1).End(xlUp).Row
    
    'オートフィルタ後に実行
    Range("B1", Range("c1").End(xlDown)).Select
    ActiveSheet.Shapes.AddChart2(Style:=297, XlChartType:=xlBarStacked, Left:=200, Top:=20, Width:=400, Height:=400).Select
    'ActiveChart.SetSourceData Source:=Range("B1：c" & Line).Select
    ActiveSheet.ChartObjects(1).Name = "my"
    
    Set ChartObj = ActiveSheet.ChartObjects(1)
    
    '補助線
    ActiveChart.Axes(xlValue).HasMinorGridlines = True
    ActiveChart.Axes(xlValue).MinorUnit = 1
    
    Range("D1", Range("D1").End(xlDown)).Select
    Selection.Copy
    ActiveSheet.ChartObjects("my").Activate
    ActiveChart.Paste
    
    '軸の日付の範囲
    'ActiveChart.Axes(xlValue).MinimumScale = 43922
    'ActiveChart.Axes(xlValue).MaximumScale = 43981
    
    'データラベル表示
    ActiveChart.SetElement (msoElementDataLabelCenter)
    
    ActiveChart.FullSeriesCollection(1).Select
    Selection.Format.Fill.Visible = msoFalse
    
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True

End Sub

つまりは、オートフィルタかけて最終行を取得して、グラフ作って設定をごにょごにょしただけです。

無料noteはこちらから↓↓

note.com