フィルをマクロで操作し、カレンダーを作成（昨日の微修正）

昨日は、フィルをマクロで操作して、即席カレンダーを作成してみた。
infoment.hatenablog.com

このテーマは昨日で終わりと思っていたが、よく見てみると、このカレンダーには曜日の表示が無い。

このままでは、2019年を終われない。昨日の微修正を行うことにした。

作戦として、カレンダーの起点となる日付を、更に一週間前にしてみた。

この行の表示形式を曜日にすれば、曜日行の完成だ。

Sub CreateCalendar(specified_date As Date)

    ' カレンダーの表題（yyyy年m月）をセットする範囲。
    With Range("A1").Resize(, 7)
        .Merge
        .Value = Format(specified_date, "yyyy年mm月")
        .HorizontalAlignment = xlCenter
    End With
    
    ' カレンダーの起点となる日付を入力。
    ' ※曜日表示用に、一行目はカレンダ開始日の一週間前を指定。
    Range("A2") = CalendarFirstDay(specified_date) - 7
    
    ' 全ての日曜日をセット。
    Dim myRng As Range
    Set myRng = DataSeriesRange(destination_range:=Range("A2"), _
                                dsStep:=7, _
                                dsStop:=Range("A1").Value + 42, _
                                dsRowCol:=xlColumns)
                             
    ' 各週の全ての日付をセット。
    Set myRng = DataSeriesRange(destination_range:=myRng.Resize(, 7), _
                                dsTrend:=True)
    
    ' 書式の調整。
    With myRng
        .NumberFormatLocal = "d"
        
        ' ↓ 本日追加 ------------------------------------------
        ' 一行目を曜日で表示。
        .Rows(1).NumberFormatLocal = "aaa"
        ' 曜日表示と日付の間に罫線を描画。
        .Rows(1).Borders(xlEdgeBottom).Weight = xlThin
        ' ↑ 本日追加 ------------------------------------------
        
        .Columns(1).Font.Color = vbRed
        .Columns(7).Font.Color = vbBlue
        .ColumnWidth = 2.5
        .HorizontalAlignment = xlCenter
    End With
    
    ' 当月以外について、灰色地で塗り潰し。
    Dim r As Range
    Dim i As Long
        For i = 2 To 8  ' ← 本日追加 ---------------------------
            For Each r In myRng.Rows(i).Cells
                If Month(r) <> Month(myRng.Cells(3, 1)) Then
                    r.Interior.ThemeColor = xlThemeColorDark1
                    r.Interior.TintAndShade = -0.149998474074526
                End If
            Next  ' ← 本日追加 ---------------------------------
        Next
End Sub

結果は、以下のとおり。

今年の更新は、これでおしまいです。

参考まで。