【エクセルVBA】スケジュール（ガントチャート）作成マクロ2 ～表作成まで～

まずはスケジュールの大枠である表を作成していきます。

【準備】

　セルD2にスケジュールの一番初めの日、セルD3に最終日を入力します。

（タスクの開始、終了日を範囲としたmin関数とmax関数を使ってもいいです。）

　「祝日」シートを作成し、A列に祝日を羅列しておきます。

【マクロ】
まず最初にいくつか定義しておきます。

    Dim startday As Range
    Dim endday As Range
    Dim daysStartCell As Range
    Dim taskCell As Range
    Dim printAreaStart As Range
    Dim xxx As Range
    Dim GetMonth As Long
    Dim GetWeek As Long
    Dim holydayCell As Range

スケジュールの開始日（セルD2）と最終日（セルD3）を変数に取り込みます。そして日付と書き始めるセルをセルI6と指定します。その他もろもろも取り込みます。

    Set taskCell = Range("G6")          'タスクのタイトルセルを指示
    Set startday = Range("D2")         '作成する表の初めの日付を入手
    Set endday = Range("D3")           '作成する表の最後の日付を入手
    Set daysStartCell = Range("I6")    '表作成で日付を書き始めるセル
    Set printAreaStart = Range("G4")    '印刷範囲の初めを指定
    Set holydayCell = Worksheets("祝日").Range("A:A")

セルI6から右へ日付を記入しておきます。すごく単純にForで記述します。

    '日付を埋める
    Dim i As Integer
    For i = 0 To endday.Value - startday.Value
        daysStartCell.Offset(0, i) = startday.Value + i
    Next i

日付の記入が終わると次は、その日付に合った週番と月をその記入します。

For Eachで記入した日付を順番に見ていきます。月はMonth関数で取得し、月が変わるたびに2つ上のセルへ記入します。
週番はformat関数で取得します。一番初めの日と毎週日曜日の1つ上のセルへ記入します。

    For Each xxx In Range(daysStartCell, daysStartCell.End(xlToRight))  'xxxは週番
        '何月か書く
        GetMonth = Month(xxx)                                           '日付から何月か確認
        If GetMonth & "月" <> xxx.Offset(-2, 0).End(xlToLeft) Then      'まだ何月か書いていなければ
        xxx.Offset(-2, 0) = GetMonth & "月"                             '何月か書く
        End If
       '週番号を書く
        GetWeek = Format(xxx, "ww")
        If Weekday(xxx) = 1 Or "W" & GetWeek <> xxx.Offset(-1, 0).End(xlToLeft) Then
            xxx.Offset(-1, 0) = "W" & GetWeek
        End If
    Next

次に罫線を作成します。

まずは、表を作成する範囲を把握します。その範囲全体の罫線を実線で引き、水平な線だけ破線にします。

    '罫線を引く
    Dim LastCol As Integer
    Dim LastRow As Integer
    
    LastCol = Cells(daysStartCell.Row, Columns.Count).End(xlToLeft).Column  '日付が記載されている最後の列
    LastRow = Cells(Rows.Count, taskCell.Column).End(xlUp).Row              'タスクが記載されている最後の行
    Range(taskCell, Cells(LastRow, LastCol)).Select                         'タスクの表題から最後の行列まで選ぶ
    Selection.Borders.LineStyle = xlContinuous                              '全て囲う罫線を引く
    Selection.Borders(xlInsideHorizontal).LineStyle = xlDash                '水平な線は破線にする

これだけでも見た目はOKですが、少しこだわります。垂直方向の罫線も週の始まり（土曜と日曜の間）は実線でそれ以外は破線にして、土日祝日はグレーでハイライトするようにします。ここで準備で作成した祝日シートを活用します。作成方法は単純でFor Each関数で記入した日付を見に行って週の始まりなら（日付の上に週番が記入されていれば）何もしない、週の始まりでないなら（日付の上のセルが空欄なら）破線にします。また日付からweekday関数で曜日を確認し土日であるもしくは、祝日シートに記入した日付であればグレーにハイライトします。

    Dim yyy As Range
    For Each yyy In Range(daysStartCell, daysStartCell.End(xlToRight))    'yyyは日付の最初から最後まで選ぶ
        If yyy.Offset(-1, 0) = "" Then                                      'yyyの上が空欄なら
        Range(yyy, yyy.Offset(LastRow - yyy.Row, 0)). _
        Borders(xlEdgeLeft).LineStyle = xlDash                              '垂直な線を破線にする
        End If
        
        '土日に色をつける
        If Weekday(yyy) = 1 Or Weekday(yyy) = 7 Then
            Range(yyy, yyy.Offset(LastRow - yyy.Row, 0)).Select
            With Selection.Interior
              .ThemeColor = xlThemeColorDark2
            End With
        End If
        '祝日に色をつける
        If Not holydayCell.Find(what:=yyy) Is Nothing Then
            Range(yyy, yyy.Offset(LastRow - yyy.Row, 0)).Select
            With Selection.Interior
              .ThemeColor = xlThemeColorDark2
            End With
        End If
    Next

おまけに見出し行の罫線を二重線にし、印刷範囲を指定して終わりです。

    Range(taskCell, daysStartCell.End(xlToRight)).Select
    Selection.Borders(xlEdgeBottom).LineStyle = xlDouble                    '見出し行を二重線にする
    
    ActiveSheet.PageSetup.PrintArea = Range(printAreaStart, Cells(LastRow, LastCol)).Address '印刷範囲指定