[Excel VBA] Excelガントチャート を作る

1. 機能概要

こんな感じの「Excelガントチャート」ツールを作っていきます。

[紹介ビデオ]

図．全体図

図．スケジュール更新をコンテキストメニューから行う様子

図．設定１

図．設定２

2. ベースのエクセルシートを作成

[概要]

VBA 無しで、まずはベース部分を作ってみます。

要求事項はこんな感じで。

1. 「計画」と「実績」を分けて記載できるようにする。
2. 分解能を 1日 とする。
3. WBSを100とする。
4. 6カ月程度のスケジュールとする。
5. 「担当者」欄を設ける。
6. 「ステータス」欄を設ける。

カレンダーの月、日の部分は一旦空欄にしておきます。ここは次の章で作っていきます。

ここでは下図のような感じでレイアウトを作ってみました。

「カテゴリ」はグルーピングなどを意識した項目です。「大分類」「中分類」など複数列にしても良いかもしれません。

サンプル： ダウンロード

3. カレンダー部分を作る

[概要]

引き続き VBA 無しで、条件付き書式、excelのセルへの関数指定、などでさらにベース部分を作りこみしてみます。

3-1. 「開始日」を指定でカレンダーを更新

最初に日を表示する部分の書式を変更します。
"セルの表示設定" を "日のみ"(d) にします。"=date(Y1)" とすることでも同じことをできますが、後で示す曜日の実現でこのセルには年月日の全ての情報を持っていてほしいので、表示形式で"日のみ"の表示を実現します。

続いて、カレンダーの最も左側の日付を「開始日」と同じ日にします。

それ以降の日を、一つ左側のセルの翌日とします。

左側から２つ目のセルを設定したらドラッグでOKです。

3-2. 月を表示

次に月の部分を作ります。

月表示は以下の条件で行います。

・最も左側のセルは月を表示

・各月の１日に対応するセルは月を表示

・以上の条件以外、空欄

"セルの書式設定" を "月のみ"(m)とします。

一番左側のセルは、真下と同じ日付を代入、月をそのまま無条件で表示します。

それ以外のセルは、参照するセルを各セルの真下として、日付が１のときだけ日付を代入し、それ以外は空欄を代入します。

3-3. 曜日を表示

次に曜日表示です。こちらは全部のセルが同じ手順です。

真上のセルを参照し、「=TEXT(AH5, "AAA")」という式で曜日を計算して表示してくれます。

3-4. 月の部分は 1日なら左側に縦罫線、翌日が"END"なら右側に縦罫線

今のままでは月の切り替わり部分、最終セルの右側、に罫線がありません。

美しくないので、ここに罫線を自動追加されるように "条件付き書式" を設定します。

月部分の全セルを選択後、"条件付き書式"を設定します。

これで月の切り替わりに罫線が入りました。

同様に、最終列に罫線を加える作業をします。最終列のセルに "END" という表記を入れてこれをマークにして書式指定します。

この場合は右側に縦の罫線を追加します。

こういう書式設定を行いました。

最終列にも罫線が入りました。

3-5. カレンダーの土日を別の色にする

こちらも条件付き書式を使って実現します。こちら比較的簡単なのでラフに記載します。

1. 条件付き書式で新しいルールを作成します。

色付けする範囲を選択後、条件付き書式から「新しいルール」を選択します。

2. ルールは「数式を使用して、書式設定をするセルを決定」とし、ルールを下図のように設定します。

5 の方のみを"$"で指定します。AHに"$"を付けてはいけません。

=TEXT(AH$5,"aaa")="土"

TEXT 関数で "aaa" の指定は曜日表記のところでも使用しました。便利なのでぜひ覚えていただきたいです。

セルの色は［書式(F)...］から水色を設定しました。

3. 「条件付き書式ルールの管理」から状態を確認すると、下図のようになっているはずです。

書式ルールの表示として「このワークシート」を選択してください。

適用先を色を付ける全ての範囲として、下図では、"$AH$5:$H$106" を設定できています。

4. 同様に日曜日も同じ手順で進めます。

書式設定の部分で "土" を "日" へ変更するだけなので、説明は割愛します。

サンプル： ダウンロード

4. 設定１ を作る

[概要]

引き続き VBA 無しで、条件付き書式、excelのセルへの関数指定、などでさらにベース部分を作りこみしてみます。

5. ガントチャート(図)を描画

[概要]

計画、実績 の期間を入力したら、その内容に従ってガントチャート（図）を作図する処理を追加します。

VBA を使います。

1.

まずは基本的な部分から。

線を描画するには Shapes.AddLine という関数を使用することでできるようです。
そのまま直接使ってもよさそうですが、複数個所で使用しそうな気がするので、あとで一括して変更することを想定して標準モジュール内で関数化しました。

'
' 概要：    線を引く
'
' 引数：    sheet       線を引くシート
'           beginX      線の起点 X
'           endX        線の起点 Y
'           beginY      線の終点 X
'           endY        線の終点 Y
' 戻値：    shape       引いた線
Function drawLine(sheet As Worksheet, beginX As Long, beginY As Long, endX As Long, endY As Long) As shape
    Set drawLine = sheet.Shapes.AddLine(beginX, beginY, endX, endY)
End Function

2.

計画の線を引く、実績の線を引く、という２つの関数を作成します。

開始と終了のセルを指定することでその間に線を描画する、という内容です。

ガントチャートシートのVBAとして記載します。

Private Const START_DATE_RANGE = 34
Private Const START_WBS = 7
Private Const GANTCHART_SHEET_NAME = "ガントチャート（6か月）"
Private Const SETTING_SHEET_1_NAME = "設定1"
Private Const SETTING_SHEET_2_NAME = "設定2"
Private Const NAME_KEIKAKU = "keikaku_"
Private Const NAME_JISSEKI = "jisseki_"


'
' 概要：    計画の線を一本引く
'
Private Function 計画の線を引く(startCell As Range, endCell As Range) As shape
    Dim thisShape As shape
    Set thisShape = drawLine(ThisWorkbook.ActiveSheet, startCell.Left + 2, startCell.Top + startCell.Height / 4, endCell.Left + endCell.Width, endCell.Top + endCell.Height / 4)
    With thisShape.Line
        .DashStyle = msoLineSolid
        .ForeColor.ObjectThemeColor = ThisWorkbook.Sheets(SETTING_SHEET_2_NAME).Range("D3")
        .ForeColor.TintAndShade = ThisWorkbook.Sheets(SETTING_SHEET_2_NAME).Range("D4")
        .Weight = ThisWorkbook.Sheets(SETTING_SHEET_2_NAME).Range("D5")
        
    End With
    
    thisShape.name = NAME_KEIKAKU & startCell.Row
    
    Set 計画の線を引く = thisShape
End Function


'
' 概要：    実績の線を一本引く
'
Private Function 実績の線を引く(startCell As Range, endCell As Range) As shape
    Dim thisShape As shape
    Dim settingSheet As Worksheet
    
    Set settingSheet = ThisWorkbook.Sheets(SETTING_SHEET_2_NAME)
    
    Set thisShape = drawLine(ThisWorkbook.ActiveSheet, startCell.Left + 2, startCell.Top + startCell.Height * 3 / 4, endCell.Left + endCell.Width, endCell.Top + endCell.Height * 3 / 4)
    
    With thisShape.Line
        .DashStyle = msoLineSolid
        .ForeColor.ObjectThemeColor = settingSheet.Range("D6")
        .ForeColor.TintAndShade = settingSheet.Range("D7")
        .Weight = settingSheet.Range("D8")
        
        .BeginArrowheadStyle = msoArrowheadOpen
        .BeginArrowheadLength = msoArrowheadShort
        .BeginArrowheadWidth = msoArrowheadNarrow
        .BeginArrowheadLength = settingSheet.Range("D9").Value   ' msoArrowheadShort
        .BeginArrowheadWidth = settingSheet.Range("D10").Value   ' msoArrowheadNarrow
        
        .EndArrowheadStyle = msoArrowheadOpen
        .EndArrowheadLength = msoArrowheadShort
        .EndArrowheadWidth = msoArrowheadNarrow
        .EndArrowheadLength = settingSheet.Range("D11").Value    ' msoArrowheadShort
        .EndArrowheadWidth = settingSheet.Range("D12").Value     ' msoArrowheadNarrow
        
    End With
    
    thisShape.name = NAME_JISSEKI & startCell.Row
    
    Set 実績の線を引く = thisShape
    
End Function

3.

ガントチャート全体を更新する関数（UpdateGantchar()）を作成します。

「線を一括削除する」関数の部分は後程。

'
' 概要：    シート上の線(Line)を全て消す
'
Public Sub deleteAllLines()
    Call 線を一括削除する(ThisWorkbook.Sheets(GANTCHART_SHEET_NAME))
End Sub


'
' 概要：    ガントチャート表示の最初の日を日付型（Date）で取得します。
'
' 戻値：    ガントチャート表示の最初の日を日付型（Date）で返します。
'
' 補足：    CDate 関数は、文字列や数値などを日付型 (Date) に変換します。
'           下記では CDate(Cells(5,29)) としていますが、CDate(Cells(5,20)) でも同じ結果となります。
'
Function GetStartDate() As Date
    GetStartDate = CDate(Cells(5, START_DATE_RANGE))
End Function


'
' 概要：    ガントチャート表示の最後の日を日付型（Date）で取得します。
'
' 戻値：    ガントチャート表示の最後の日を日付型（Date）で返します。
'
' 補足：    CDate 関数は、文字列や数値などを日付型 (Date) に変換します。
'           最後の日の見つけ方を１行目の末尾セル（'END'が記載されている場所）として探しているので
'           １行目の 'END'を消したり'END'以降に何かを書くと正常に動作しません。
'
Function GetEndDate() As Date
    GetEndDate = CDate(Cells(5, getMaxCol(ThisWorkbook.ActiveSheet, 1)))
End Function


'
' 概要：    ガントチャート表示を更新する
'
Public Sub UpdateGantchart()
    Dim thisShape As shape
    Dim keikaku_start As Long
    Dim keikaku_end As Long
    Dim jisseki_start As Long
    Dim jisseki_end As Long
    
    Dim retStart As Long
    Dim retEnd As Long
    
            
    ' 全てのラインを消す
    Call deleteAllLines
    
    Dim i As Long
    For i = START_WBS To getMaxRow(ThisWorkbook.ActiveSheet, 1)
    
        ' 計画を描画
        If Cells(i, "V").Value <> "" And Cells(i, "Y") <> "" Then
        
            retStart = SearchDate(Cells(i, "V"))
            If retStart <> -1 Then
                keikaku_start = retStart
            Else
                keikaku_start = START_DATE_RANGE
            End If
            
            retEnd = SearchDate(Cells(i, "Y"))
            If retEnd <> -1 Then
                keikaku_end = retEnd
            Else
                keikaku_end = getMaxCol(ThisWorkbook.ActiveSheet, 1)
            End If
            
            If (GetEndDate() - CDate(Cells(i, "V").Value) >= 0) And (CDate(Cells(i, "Y")) - GetStartDate() >= 0) Then
                Set thisShape = 計画の線を引く(Cells(i, keikaku_start), Cells(i, keikaku_end))
            End If
        End If
        
        ' 実績を描画
        If Cells(i, "AB") <> "" And Cells(i, "AE") Then
            retStart = SearchDate(Cells(i, "AB"))
            If retStart = -1 Then
                jisseki_start = START_DATE_RANGE
            Else
                jisseki_start = retStart
            End If
            
            retEnd = SearchDate(Cells(i, "AE"))
            If retEnd = -1 Then
                jisseki_end = getMaxCol(ThisWorkbook.ActiveSheet, 1)
            Else
                jisseki_end = retEnd
            End If
            
            If (GetEndDate() - CDate(Cells(i, "AB").Value) >= 0) And (CDate(Cells(i, "AE")) - GetStartDate() >= 0) Then
                Set thisShape = 実績の線を引く(Cells(i, jisseki_start), Cells(i, jisseki_end))
                
                If retStart = -1 Then
                    With thisShape.Line
                        .BeginArrowheadStyle = msoArrowheadNone
                    End With
                End If
                
                If retEnd = -1 Then
                    With thisShape.Line
                        .EndArrowheadStyle = msoArrowheadNone
                    End With
                End If
            End If
        End If
    Next i
End Sub

下記部分について補足です。
ここは実績の線を引くときに、開始日や終了日がカレンダー範囲外であるときに矢印の形状を変更しています。

具体的には、例えば → を － へ変更することで終端でないことを表現しています。

            If (GetEndDate() - CDate(Cells(i, "AB").Value) >= 0) And (CDate(Cells(i, "AE")) - GetStartDate() >= 0) Then
                Set thisShape = 実績の線を引く(Cells(i, jisseki_start), Cells(i, jisseki_end))
                
                If retStart = -1 Then
                    With thisShape.Line
                        .BeginArrowheadStyle = msoArrowheadNone
                    End With
                End If
                
                If retEnd = -1 Then
                    With thisShape.Line
                        .EndArrowheadStyle = msoArrowheadNone
                    End With
                End If
            End If

4.

上記関数を呼ぶためのトリガーとして、セルの値が更新されたときにガントチャート更新を実施するように Worksheet_Change() 関数を設定します。

具体的には、計画および実績の開始日・終了日を変更することでバーチャートが更新されるイメージです。

'
' 概要：    セルに変化があった時のイベント処理
'
' 著作：    木下英俊
' 履歴：
'           2020-07-08 新規作成
'
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ' レイアウト更新
    Call UpdateLayout
    
    ' ナンバリングを更新
    'Call UpdateNumbering
    Call UpdateNumbering2
    
    ' ガントチャートを更新
    Call UpdateGantchart
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

6. 描画済みガントチャート(図)を全削除

[概要]

描画済みのガントチャート(図)を全て削除する処理を追加します。画面更新するためには、一旦すべての表示済みの線を削除する必要があります。

「線を一括削除する」という関数を作成します。汎用性を考えて標準モジュールとして作成しています。これに伴って引数として対象のシートを渡す必要があります。

'
' 概要：    線を一括削除する
'
' 引数：    sheet       処理対象のシート
'
' 著作：    木下 英俊
' 履歴：    2020-07-07  新規作成
' 補足：    Excel画面から手動で描画した線の Type は "msoAutoShape" になって区別できるようです。
'           "msoAutoShape" の値は 1 です。
' 参考：    https://docs.microsoft.com/ja-jp/office/vba/api/office.msoshapetype
'
Sub 線を一括削除する(sheet As Worksheet)
  Dim shp As shape
  For Each shp In sheet.Shapes
    If shp.Type = msoLine Then
        shp.Delete
    End If
  Next shp
End Sub

このプログラム中で描画する線は Type = msoLine (9) となります。

ちなみに Excel で通常描画する線の Type を確認してみたら msoAutoShape (1) でした。
このため上記プログラムで線を削除するとガントチャートで自動作成した線のみを削除できます。手動で描いた線は残るので便利で良い感じになりました。

ここまでの内容で、セルに直接日付を入力すればガントチャート上に線を描画できるように（たぶん）なったはずです。

あとはセルを選択してからコンテキストメニューをクリックする、という処理の部分だけですね。

サンプルプログラム

以上の内容を全て（＋アルファ？）した Excelガントチャート を以下からダウンロードできます。
私自身が業務で使用することを目的にこれをブラッシュアップしているので、ここのが一番完成度が高いです。

サンプルプログラム ダウンロード

変更履歴

ライセンス

本ページの情報は、特記無い限り下記 MIT ライセンスで提供されます。

参考

• [Excel]VBAで「右クリックメニュー」を追加する
  https://m0ratorium.com/vba-rightclickmenuadd/
• Shape プロパティ (Excel)
  https://docs.microsoft.com/ja-jp/office/vba/api/excel.shape.line
• 特定のオブジェクトを削除する
  http://www4.synapse.ne.jp/yone/excel2010/excel2010_zu_obje_del.html
• 右クリックメニューやサブメニューにマクロを登録／削除するには
  https://www.atmarkit.co.jp/ait/articles/1408/25/news030.html
• 【VBA】選択したセルを取得する『Selectionプロパティ』の使い方
  https://detail-infomation.com/vba-selection/
• Excel VBAで外部ファイルのモジュールを読み込み実行する方法
  https://eijiman.com/execute-external-file-module-excel-vba/
• MsoShapeType 列挙 (Office) | Microsoft Docs
  https://docs.microsoft.com/ja-jp/office/vba/api/office.msoshapetype

変更履歴

Programming Items トップページ

プライバシーポリシー