Excel de ガントチャート その3

　こんにちは！Excelイケオジです。焼き上がった脂のしたたる肉に華麗に塩をふる練習にいそしむ毎日を送っています。

準備

　Excelで何でもできる気がしてきましたが、とりあず、矢印の強化と稲妻線を引いてみることにします。とりあえずタスクを適当に増やします。さしあたって以下のようにタスクを追加してみました。

進捗バーの変更

稲妻線を引いてみて思ったのですが、進捗が今日よりも進んでいる場合にも色をつけた方がわかりやすく思ったので、書式付きルールを少し変更します。"数式を使用して、書式設定するセルを決定"を選択、数式は以下になります。『=AND($E$3<=J$4,$D6<=J$4,J$4<ROUNDDOWN(($E6-$D6)*$F6+$D6,0))』

書式は緑の網掛けのようにします。

ルールの並びは以下のようにしています。

これによって、進捗が現在の日付を超えて進んでいる場合にはこの緑で表示されるようになりました。

関係性の矢印の強化

関係性を示す矢印は少し雑だったので、変更してみました。VBAのプログラムと結果だけを貼っておきます。矢印を引く関数だけが変更されています。

'セルからセルへ 矢印を引く関数のVersion2
Sub DrawArrowV2(StartCell, StopCell)

    ' 始点の座標を計算
    Start_PosX = (StartCell.Offset(0, 1).Left - StartCell.Left) * 1 + StartCell.Left
    Start_PosY = (StartCell.Offset(1, 0).Top - StartCell.Top) * 0.5 + StartCell.Top
    Start_PosX2 = (StartCell.Offset(0, 1).Left - StartCell.Left) * 1.5 + StartCell.Left
    Start_PosX3 = (StartCell.Offset(0, 1).Left - StartCell.Left) * 1.5 + StartCell.Left

    '終点の座標を計算
    Stop_PosX = (StopCell.Offset(0, 1).Left - StopCell.Left) * 0 + StopCell.Left
    Stop_PosY = (StopCell.Offset(1, 0).Top - StopCell.Top) * 0.5 + StopCell.Top
    Stop_PosX2 = (StopCell.Offset(0, 1).Left - StopCell.Left) * -1 + StopCell.Left
    Stop_PosX3 = (StopCell.Offset(0, 1).Left - StopCell.Left) * -0.5 + StopCell.Left

    If Stop_PosX2 <= Start_PosX2 Then
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Start_PosX, Start_PosY, Start_PosX2, Start_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
        End With
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Start_PosX2, Start_PosY, Stop_PosX2, Stop_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
        End With
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Stop_PosX2, Stop_PosY, Stop_PosX, Stop_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
            .EndArrowheadStyle = msoArrowheadTriangle '終点を矢印
        End With
    Else
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Start_PosX, Start_PosY, Start_PosX3, Start_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
        End With
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Start_PosX3, Start_PosY, Start_PosX3, Stop_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
        End With
        ' ラインを引く
        With ActiveSheet.Shapes.AddLine(Start_PosX3, Stop_PosY, Stop_PosX, Stop_PosY).Line
            .Weight = 3
            .ForeColor.RGB = RGB(0, 128, 255)
            .EndArrowheadStyle = msoArrowheadTriangle '終点を矢印
        End With
    End If

End Sub

この関数を呼び出す箇所を修正します。

ボタンをおして矢印を引き直すと、少しは矢印が見やすくなりました。

イナズマ線

さらに上を上を目指す皆様向けにイナズマ線を実装してみました。関係性の矢印ができていれば実装自体は難しくないのですが、まずは書きました。

Sub Inazuma_Click()
   '初めに線を消していく
    wkCnt = ActiveSheet.Shapes.Count
    For i = wkCnt To 1 Step -1
        '線だったら
        If ActiveSheet.Shapes(i).Type = 9 Then
           If ActiveSheet.Shapes(i).Line.Weight = 2 Then
                ActiveSheet.Shapes(i).Delete
           End If
        End If
    Next

    '表示の初めの日付
    StartDate_Sheet = Range("J4")
    
    '今日の日付
    TodayDate_Sheet = Range("E3")
    
    '線の開始
    Dim StartCell As Range
    Set StartCell = Range("J6").Offset(-1, TodayDate_Sheet - StartDate_Sheet)

    'G6 から10行のタスクを一つずつ確認していく
    For Index = 0 To 10

        'それぞれの先行タスクの終了日と元タスクの開始日を特定する
        StopDate = Range("E6").Offset(Index, 0)
        If IsEmpty(StopDate) Then
            GoTo Continue
        End If
        StartDate = Range("D6").Offset(Index, 0)
        Progress = Range("F6").Offset(Index, 0)
        If TodayDate_Sheet < StartDate And Progress = 0 Then
            CurrentDate = TodayDate_Sheet
        Else
            CurrentDate = WorksheetFunction.RoundDown((StopDate - StartDate) * Progress + StartDate, 0)
        End If
            
        '日付から線の始点と終点になるセルを特定
        Dim StopCell As Range
        Set StopCell = Range("J6").Offset(Index, CurrentDate - StartDate_Sheet)
            
        'セルからセルへ ラインを引く関数を呼び出す
        Call DrawLine(StartCell, 0, 0.5, StopCell, 0, 0.5)

        Set StartCell = StopCell

Continue:
    Next
End Sub

'セルからセルへラインを引く関数
Sub DrawLine(StartCell, StartPosX, StartPosY, StopCell, StopPosX, StopPosY)
    ' 始点の座標を計算
    Start_PosX = (StartCell.Offset(0, 1).Left - StartCell.Left) * StartPosX + StartCell.Left
    Start_PosY = (StartCell.Offset(1, 0).Top - StartCell.Top) * StartPosY + StartCell.Top

    '終点の座標を計算
    Stop_PosX = (StopCell.Offset(0, 1).Left - StopCell.Left) * StopPosX + StopCell.Left
    Stop_PosY = (StopCell.Offset(1, 0).Top - StopCell.Top) * StopPosY + StopCell.Top

    ' ラインを引く
    With ActiveSheet.Shapes.AddLine(Start_PosX, Start_PosY, Stop_PosX, Stop_PosY).Line
        .Weight = 2
        .ForeColor.RGB = RGB(240, 28, 28)
    End With
End Sub

この関数をボタンから呼び出すようにします。ボタンをおいて「マクロ登録」で定義した「Imazuma_Click」を選択します。

ボタンを押すと以下のようにラインが引かれます。まあまあですね。。

線の表示・非表示切り替え

それぞれの線が常に表示されていると見にくいことがあるので、ボタンを押すことで表示と非表示が切り替わるようにします。セルに現在の状態をもって、その値に従って、動作を変える仕様になっています。他の実装方法もあるかもしれません。

まずは線や矢印の太さを見て、線や矢印を消していく関数を作ります。
関係矢印とイナズマ線の太さを変えることで、それぞれを分けて消していくことができます。ここでは太さを見ていますが、色などで判別して消していくことも可能です。

Sub DeleteLine(WeightDelete)

    '初めに線を消していく
    wkCnt = ActiveSheet.Shapes.Count
    For i = wkCnt To 1 Step -1
        '線だったら
        If ActiveSheet.Shapes(i).Type = 9 Then
            If ActiveSheet.Shapes(i).Line.Weight = WeightDelete Then
                ActiveSheet.Shapes(i).Delete
            End If
        End If
    Next
End Sub

この関数をG1やH1の状態を見て、呼んだり呼ばなかったりしていきます。「Exit Sub」を使っていますが、これで関数を途中で抜けています。これはプログラムのインデントを減らして読みやすくするためのテクニックになります。

Relation_Click()のはじめは以下のように書き換えます。

'ボタンをクリックした呼び出される関数
Sub Relation_Click()

    'G1を 関係矢印の状態を持つ変数として使う
    Relation_Status = Range("G1") '1:表示、0:非表示
    If Relation_Status = 1 Then
        ' 表示されていたら線を消していく
        Call DeleteLine(3) '3 は 関係矢印の太さ
        
        Range("G1").Value = 0  '非表示に 状態を切り替え
        'この関数を修了する
        Exit Sub
    End If

    Range("G1").Value = 1   '表示に状態を切り替え

    '表示の初めの日付
    StartDate_Sheet = Range("J4")

Inazuma_Click()のはじめは以下のように書き換えます。

Sub Inazuma_Click()

    ' H1をイナズマ線の状態を持つ変数として使う
    Inazuma_Status = Range("H1") '1:表示、0:非表示
    If Inazuma_Status = 1 Then
        ' 表示されていたら線を消していく
        Call DeleteLine(2)  '2 はイナズマ線の太さ
        
        Range("H1").Value = 0  '非表示に 状態を切り替え
        'この関数を修了する
        Exit Sub
    End If

    Range("H1").Value = 1   '表示に状態を切り替え

    '表示の初めの日付
    StartDate_Sheet = Range("J4")

ボタンの上に数字が表示されて、少し不恰好ですが、ボタンをクリックするたびに表示・非表示が切り替わるようになりました。

関係性が表示されて、イナズマ線が表示されて、本格的なガントチャートに近づいてきました。ここでできたExcelは下からダウンロードできるようにしておきます。必要な方はダウンロードしてください。次回もこれをベースに修正していきます！