会社の出勤日をカレンダーに反映してみる - Infomentのブログ～Excel VBA奮闘記～

昨日は、ユーザーフォーム上に散らかしたコマンドボタンをじわじわ集めて当月のカレンダーっぽいものを作成し、ついでに前月・土曜・日曜・当日に色を付けて、見える化してみた。
infoment.hatenablog.com
一年中全て土日が休みでそれ以外が平日なら、前回作成分までで良いのだが、世の中には他にも日付の種類がある。

祝日
勤め先が定める出勤日（土日祝日関係なく）
個人の予定で平日に休む
などなど

そこで今回は、これらをカレンダーに反映してみる。
f:id:Infoment:20181126223201p:plain

さすがのExcelも、個人の予定までは分からない。そこは、教えてあげないと。
ということで、休日と出勤日をまとめた表を一つ作成した。
※11/17（土）は、今回記事のために設定した偽の出勤日です。
f:id:Infoment:20181126223332p:plain

今回の作戦は、こうだ。

まず平日や土日に対応した色で、とりあえず文字色を決める。
次いで、上表の内容を文字色に反映（上書き）する。

ユーザーフォーム

まず、表の内容で辞書（連想配列）を作成する。

' 今回追加
Private Property Get HolidayDict() As Dictionary
    Dim HolidayTable As ListObject
    Set HolidayTable = Sheets("勤休シート").ListObjects(1)
    
    'Microsoft Scripting Runtime 参照設定済み
    Dim TempDict As Dictionary
    Set TempDict = New Dictionary
    
    Dim r As Range
    For Each r In HolidayTable.DataBodyRange.Columns(1).Cells
        TempDict(r.Value) = r.Offset(, 1).Value
    Next
    
    Set HolidayDict = TempDict
    
End Property

この辞書の内容は、以下のとおり。

キー	日付
アイテム	勤休区分

次いで、昨日の「文字色を決めるユーザー定義関数」に、上記内容を追加する。

Private Function myFontColor(myDate As Date) As Double
    Select Case WorksheetFunction.Weekday(myDate)
        Case vbSunday:   myFontColor = &HC0
        Case vbSaturday: myFontColor = &HFF0000
        Case Else:       myFontColor = &H80000012
    End Select
    
    ' ↓今回追加↓
    If HolidayDict.Exists(myDate) Then
        Select Case HolidayDict(myDate)
            Case "休日": myFontColor = &HC0
            Case "出勤": myFontColor = &H80000012
        End Select
    End If
    ' ↑今回追加↑
    
    If myDate = Date Then
        myFontColor = &HFFFF&
    End If
End Function