【ガントチャート】1行Gantt chartをVBAで作成する

マクロ講座中級2023 動画編ガントチャート01回
【ガントチャート】1行Gantt chartをVBAで作成する

動画でExcelマクロ　【ガントチャート】1行Gantt chartをVBAで作成する

【ガントチャート】1行Gantt chartをVBAで作成する

動画版「ガントチャート作成講座」です。以前にもガントチャートは作成していますので、まずそれらを振り返ってみましょう。
その後で、元になるコードの流れや意味を理解してから、１行ガントチャートを作成します。

【タイムライン】 ●目次

00:00 - イントロ
00:29 - 内容紹介、過去のガントチャートの説明
02:08 - 皆さまの質問にお答えできなかった言い訳
03:24 - １行ガントチャートと月単位のガントチャートを作成
05:27 - 通常のレクタングルにタスク入りのガントチャートコード解説
13:23 - １行ガントチャートのコード
18:06 - 月単位のガントチャートの予告
18:46 - コードタイム
18:07 - End

マクロ動画　【ガントチャート】1行Gantt chartをVBAで作成する

https://youtu.be/5MWfm51Ia1g

過去のガントチャートの例

中級編の82回では、このような矢印を利用したGanttチャートを作成したんですね。
ただし、１行ずつ矢印を入れてくというものでした。

83回では、同じく矢印ですけれども、どこが違うのかといったら、少し自動化が進んだGanttチャートなんですね。こちらの表のC列D列に、開始日と終了日が入力されていますけれども、それを読み取って、自動で一気にGanttチャートを入れていくコードになりました。

そして84回では、ガントチャートの図形を矢印から普通のレクタングルに変更しました。
それは、いつからいつまでは設計で、手配で、加工で組み立てでなどということがわかるように、レクタングルの中にその工程の内容を記述したガントチャートを作成するためのものでした。

今回は、その８４回のガントチャートの上に、比較のために表示しましたが、ガントチャートを１行表示にするというマクロを作成します。

１行ガントチャートは８４回の項目を表示できるガントチャートのコードを元に作成しますので、
復習を兼ねて、８４回のガントチャートのコードがどのようなものであったかを解説します。

ガントチャートで使うFindメソッド

Range.Find メソッド

名前	必須 /OP	Variant	説明
What	必須	Variant	検索するデータです。指定できるのは、文字列、または任意の Microsoft Excel のデータ型です。
After	省略可能	Variant	このセルの後から検索を開始します。これは、ユーザーインターフェイスから検索が実行されたときにアクティブなセルの場所に対応しています。 After?は範囲内の 1 つのセルにする必要があることに注意してください。このセルの後から検索が開始されるため、メソッドによって範囲内の他のセルがすべて検索され、このセルに戻るまで、指定されたセルは検索されません。この引数を指定しない場合は、範囲の左上端のセルの後から検索が開始されます。
LookIn	省略可能	Variant	使用できるのは、XlFindLookIn定数:?xlFormulas、xlValues、xlComments?あるいは?xlCommentsThreaded?のいずれかです。
LookAt	省略可能	Variant	次のXlLookAt定数:xlWholeあるいはxlPartのいずれかになります。
SearchOrder	省略可能	Variant	次のXlSearchOrder定数:xlByRowsあるいはxlByColumnsのいずれかになります。
SearchDirection	省略可能	Variant	次の?XlSearchDirection?定数:?xlNext?あるいは?xlPrevious?のいずれかになります。
MatchCase	省略可能	Variant	大文字と小文字を区別するには、True?を指定します。既定値は?False?です。
MatchByte	省略可能	バリアント型	2 バイトの言語サポートが選択またはインストールされている場合にのみ使用されます。 2 バイト文字が 2 バイト文字とだけ一致するようにする場合は、True?を指定します。 2 バイト文字が同等の 1 バイト文字とも一致するようにする場合は、False?を指定します。
SearchFormat	省略可能	バリアント型 (Variant)	検索の書式を指定します。

まず最初の部分は変数の宣言です。
ガントチャートなので、開始日と終了日の日付を変数にしています。

Sub findcolumn_makeRect_ver1()
    Dim i As Long, colorC As Long '色
    Dim startD As Date, endD As Date ' 開始日と終了日の日付
    Dim startCe As String, endCe As String, shtext As String ' タスク名
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

With wsの部分は複雑で、外側のWith構文の中にFor文があり、その中にまたWith構文が入っています。
外側のWith構文は、With ws　ということでSheet1に対しての作業であるということになります。
次のFor文は、iはカウント変数です。
そして行を表していて、６行目から .Range("A4").CurrentRegion.Rows.Count までを繰り返すという意味になります。
開始日と、終了日はどこの値からもってくるのかを決めてやります。レクタングルの色もどこの値からもってくるのかを決めてやります。

それが、以下のコードの部分になります。
startD = .Cells(i, 3).Value
endD = .Cells(i, 4).Value
colorC = .Cells(i, 5).Interior.Color
shtext = .Cells(i, 2).Value
その下の部分では、レクタングルを描画するスタート列と、エンド列を決めています。
その際に使っているのが、Range.Find メソッドです。

For文の次に行うのが、ワークシートのShapes.AddShape メソッドです。
With ws.Shapes.AddShape の部分です。

Shapes.AddShape メソッド

名前	必須 / OP	データ型	説明
型	必須	MsoAutoShapeType	作成するオートシェイプの種類を指定します。
Left	必須	Single	文書の左上隅を基準としたオートシェイプの境界ボックスの左上隅の位置 (?ポイント単位)。
Top	必須	Single	オートシェイプの境界ボックスの左上隅の位置 (ポイント単位)。
Width	必須	単精度浮動小数点型 (Single)	オートシェイプの境界ボックスの幅をポイント単位で指定します。
Height	必須	単精度浮動小数点型 (Single)	オートシェイプの境界ボックスの高さをポイント単位で指定します。

Shapes.AddShape メソッドに必要な引数を取得するために、その前のFor文においてスタートセルやエンドセルを決めたわけです。
それが、前半の部分です。
With ws.Shapes.AddShape(msoShapeRectangle, .Range(startCe).Left, _
.Range(startCe).Top, .Range(endCe).Offset(0, 1).Left - .Range(startCe).Left, _
.Range(endCe).Height)

描画したレクタングルのプロパティを設定

次のコードは描画したレクタングルのプロパティを設定する部分です。色をつけ、テキストを入力し、フォントの種類とサイズ、太字を設定しています。
.Fill.ForeColor.RGB = colorC
.TextFrame.Characters.Text = shtext
.TextFrame.Characters.Font.Size = 16
.TextFrame.Characters.Font.Bold = True
.TextFrame.Characters.Font.Name = "メイリオ"

実行するとこのようにガントチャートが作成できます。

通常のガントチャート作成コード全体は以下のようになります。

Sub findcolumn_makeRect_ver1()
    Dim i As Long, colorC As Long '色
    Dim startD As Date, endD As Date ' 開始日と終了日の日付
    Dim startCe As String, endCe As String, shtext As String ' タスク名
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    With ws
        For i = 6 To .Range("A4").CurrentRegion.Rows.Count
                startD = .Cells(i, 3).Value
                endD = .Cells(i, 4).Value
                colorC = .Cells(i, 5).Interior.Color
                shtext = .Cells(i, 2).Value
                Dim startCol As Long, endCol As Long
                startCol = .Rows(3).Find(startD).Column
                endCol = .Rows(3).Find(endD).Column
                startCe = .Cells(i, startCol).Address
                endCe = .Cells(i, endCol).Address

        With ws.Shapes.AddShape(msoShapeRectangle, .Range(startCe).Left, _
                .Range(startCe).Top, .Range(endCe).Offset(0, 1).Left - .Range(startCe).Left, _
                .Range(endCe).Height)
                        
                .Fill.ForeColor.RGB = colorC
                .TextFrame.Characters.Text = shtext
                .TextFrame.Characters.Font.Size = 16
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Name = "メイリオ"
                End With
         Next i
   End With
End Sub