マクロだけで月単位のガントチャート

ユーザーフォーム講座動画編 02回
マクロだけで月単位のガントチャート

動画でExcel　マクロだけで月単位のガントチャート

マクロだけで月単位のガントチャート

動画版「マクロ講座」ガントチャート作成編です。
今回は、Ganttチャートで月単位のGanttチャートを作成するという回になります。

●目次
00:00 - イントロ
00:29 - 内容紹介、月単位のガントチャートの説明
01:32 - 月単位のガントチャートを２通り作成
02:22 - 該当月をひとつのレクタングルで作成する月単位のガントチャートのコード解説
09:41 - 該当月のセルをひとつずつレクタングルで作成する月単位のガントチャートのコード解説
14:14 - 次回３０分単位のガントチャートの予告
14:19 - コードタイム
17:04- End

マクロ動画　マクロだけで月単位のガントチャート

https://youtu.be/GeOimeaSAEg

月単位のガントチャート2通り

前回との違いは、工程のこの工期が、一つ一つが月をまたいで長いということです。
開始日が8月5日であれば終了日は10月15日のようになっています。
当然ながらこの期間も一月単位ということです。

2通りのマクロを作成しましたが見た感じそれほど変わりません。
まず月単位のその1です。各月ごとに工程の名称が入っています。

その2のケースのマクロをやってみましょう。
その2というのは、工程の名称が初月だけに入っているというマクロです。
工程の名称を、初月だけに 1回入れる場合と、月ごとに何回も入れる場合
コードでどのような違いがあるかというのを見ていただきたいと思います。

工程の名称を初月だけ入れる月単位のガントチャート

まず最初の部分は変数の宣言です。これまでのものと同じ変数となっています。

マクロ本体のコード部分です。
Set ws = Worksheets("Sheet3")　で対象シートをSheet3に特定しています。
with ws とは、ws ＝Sheet3　に関してのコードです。
ここから全部Sheet3でやりますよということで、一番最後にEnd Withがあります。

そしてFor i = 6
i は、6行目から始まっています。
To .Range("A4").CurrentRegion.Rows.Count で
何行あるかということですね、数えます。 CurrentRegion(カレントリージョン)のRows をカウントすると、
12と出るわけですね。 12行までやろうということです。

その下の4行のコードでスタート日はどこから持ってくるか、終了日はどこから持ってくるかを、また色は何色で、工程名は何かという情報を取得しています。

     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

月単位のガントチャートに必要な変数を追加

次にまた変数が出てきます。これは月で使う変数ということなので、このマクロで追加した変数です。
開始月と終了月を設定し、開始列と終了列を設定するために必要です。
すでに取得したStartD 開始日を月単位の表に書き出すために、その月の初日に設定する必要があります。
NAMAE6

startMonth = DateSerial(Year(startD), Month(startD), 1)
endMonth = DateSerial(Year(endD), Month(endD), 1)

というのも、表の中で2023年8月という列には2023年8月1日のシリアル値が入っているからです。
同様に、EndD　終了日を、月の途中であってもシリアル値の設定でその月の1日に変更する必要があります。

今度のコードは少しわかりづらいかもしれませんが、i = 6の最初のケースだと、startCol　は、 8/1が開始月と入っているセルを3行目からFind関数で探して、そのカラム番号を取得しています。
endColは、終了月が10/1と入っているセルをFind関数で探して、そのカラム番号を取得しています。
そして、それらをアドレスに直しているのが、startCe、endCeです。

startCol = .Rows(3).Find(DateSerial(Year(startMonth), Month(startMonth), 1)).Column
endCol = .Rows(3).Find(DateSerial(Year(endMonth), Month(endMonth), 1)).Column
startCe = .Cells(i, startCol).Address
endCe = .Cells(i, endCol).Address

これらが決まったところで、ガントチャートの本体であるレクタングルをシートに描画していきます。
これには、ワークシートオブジェクトのShapes.AddShapeメソッドを使います。

     With ws.Shapes.AddShape(msoShapeRectangle, .Range(startCe).Left, _
        .Range(startCe).Top, _
        .Range(endCe).Offset(0, 1).Left - .Range(startCe).Left, _
        .Range(endCe).Height)

ガントチャートで使うShapes.AddShapeメソッド

Shapes.AddShape メソッド

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

以上のコードを実行すると、画像のような月単位のガントチャートを描画することができます。

月単位のガントチャートを作成するコード全体その2

Option Explicit
    Dim i As Long, colorC As Long '色
    Dim startD As Date, endD As Date, startMonth As Date, endMonth As Date ' 開始日と終了日の日付
    Dim startCe As String, endCe As String, shtext As String
    Dim startCol As Long, endCol As Long, ws As Worksheet
    
Sub findcolumn_makeRect_ver4()
    Set ws = Worksheets("Sheet3")

    With ws
        For i = 6 To .Range("A4").CurrentRegion.Rows.Count
            startD = .Cells(i, 3).Value
            endD = .Cells(i, 4).Value
            ' 開始月と終了月を設定
            startMonth = DateSerial(Year(startD), Month(startD), 1)
            endMonth = DateSerial(Year(endD), Month(endD), 1)
            startCol = .Rows(3).Find(DateSerial(Year(startMonth), Month(startMonth), 1)).Column
            endCol = .Rows(3).Find(DateSerial(Year(endMonth), Month(endMonth), 1)).Column
            startCe = .Cells(i, startCol).Address
            endCe = .Cells(i, endCol).Address
            Dim j As Date
            colorC = .Cells(i, 5).Interior.Color
            shtext = .Cells(i, 2).Value
            
            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

該当する月にそれぞれ工程名を入れるには

コードは、一部を除き基本的に同じです。
レクタングルを描画する部分が違います。
こちらの該当する月にそれぞれ工程名を入れるマクロでは、レクタングルの描画を1月ごとに描いているのです。

月単位のガントチャートを作成するコード全体その1

Option Explicit
    Dim i As Long, colorC As Long '色
    Dim startD As Date, endD As Date, startMonth As Date, endMonth As Date ' 開始日と終了日の日付
    Dim startCe As String, endCe As String, shtext As String
    Dim startCol As Long, endCol As Long, ws As Worksheet
Sub findcolumn_makeRect_ver3()
    Set ws = Worksheets("Sheet3")
    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
            startMonth = DateSerial(Year(startD), Month(startD), 1) ' 開始月
            endMonth = DateSerial(Year(endD), Month(endD), 1) ' 終了月
            startCol = ws.Rows(3).Find(DateSerial(Year(startMonth), Month(startMonth), 1)).Column
            endCol = .Rows(3).Find(DateSerial(Year(endMonth), Month(endMonth), 1)).Column
            Dim j As Date ' 開始月から終了月までループ
            j = startMonth
            Do While j <= endMonth
                    endCol = startCol
                    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
                j = DateAdd("m", 1, j)
                startCol = startCol + 1
            Loop
        Next i
    End With
End Sub

上記マクロを実行すると、各月に工程名が入力されたガントチャートを作成することができます。