VBAで祝日を取得する（アドオンを使わずに）

アドオン使えばできるんですが、企業で配布する場合すべてのエクセルにアドオン入れるなんて面倒です。

そこで祝日の日付データをクラス化でカプセル化して簡単に取得できるクラスを作りました。

数年前に作ったものなので効率悪いですが、まぁこの程度のコードならあまり関係ないので許してください。
祝日のデータは更新していく必要があります。ネットから自動取得なんて方法も考えられます。

Option Explicit
 
'**********************************************************************************************************
'GetEndofMonthDay(Byval SomeDay as Date) as Long            指定月日の月の最終日を取得
'GetNationalHolidayName(ByVal SomeDay As Date) As String    指定日の祝日の名前を返す。指定日が祝日でなければvbNullString(文字列無し = "")を返す。
'GetWeekDay(ByVal SomeDay As Date) As String                指定日の曜日名を"月曜日"みたいな文字列で返す
'SetDateString(ByVal SomeDay As Date, Optional ByRef yyyy As String, Optional ByRef mm As String, Optional ByRef dd As String, Optional WeekDay As String)
'SetDateLong(ByVal SomeDay As Date, Optional ByRef yyyy As Long, Optional ByRef mm As Long, Optional ByRef dd As Long, Optional WeekDay As String)
'IsHoliday(ByVal SomeDay As Date) As Boolean                指定日が休日だとTrue
'IsNationalHoliday(ByVal SomeDay As Date) As Boolean        指定日が祝日だとTrue
'**********************************************************************************************************
 
Private Type HOLIDAYINFO
    Name As String
    Days As Date
End Type
 
Private NationalHolidays() As HOLIDAYINFO
 
Private Sub Class_Initialize()
    Call SetHoliday
End Sub
 
Private Sub Class_Terminate()
    Erase NationalHolidays
End Sub
 
Private Sub SetHoliday()
'**************************************************************************************
'祝日を登録します。毎年更新してください。ユーザーが意識して使う関数ではありません。
'**************************************************************************************
 
    '************************************祝日登録(2010年版)毎年更新してください******************************
    SetHolidays "2009/1/1", "元旦"
    SetHolidays "2009/1/12", "成人の日"
    SetHolidays "2009/2/11", "建国記念の日"
    SetHolidays "2009/3/20", "春分の日"
    SetHolidays "2009/4/29", "昭和の日"
    SetHolidays "2009/5/3", "憲法記念日"
    SetHolidays "2009/5/4", "みどりの日"
    SetHolidays "2009/5/5", "こどもの日"
    SetHolidays "2009/5/6", "振り替え休日"
    SetHolidays "2009/7/20", "海の日"
    SetHolidays "2009/9/21", "敬老の日"
    SetHolidays "2009/9/22", "国民の休日"
    SetHolidays "2009/9/23", "秋分の日"
    SetHolidays "2009/10/12", "体育の日"
    SetHolidays "2009/11/3", "文化の日"
    SetHolidays "2009/11/23", "勤労感謝の日"
    SetHolidays "2009/12/23", "天皇誕生日"
    SetHolidays "2010/1/1", "元旦"
    SetHolidays "2010/1/2", "正月休み"
    SetHolidays "2010/1/3", "正月休み"
    SetHolidays "2010/1/11", "元旦"
    SetHolidays "2010/2/11", "建国記念日"
    SetHolidays "2010/3/21", "春分の日"
    SetHolidays "2010/3/22", "春分の日の振替休日"
    SetHolidays "2010/4/29", "昭和の日"
    SetHolidays "2010/5/3", "憲法記念日"
    SetHolidays "2010/5/4", "みどりの日"
    SetHolidays "2010/5/5", "こどもの日"
    SetHolidays "2010/7/19", "海の日"
    SetHolidays "2010/9/20", "敬老の日"
    SetHolidays "2010/9/23", "秋分の日"
    SetHolidays "2010/10/11", "体育の日"
    SetHolidays "2010/11/3", "文化の日"
    SetHolidays "2010/11/23", "勤労感謝の日"
    SetHolidays "2010/12/23", "天皇誕生日"
    SetHolidays "2010/12/29", "年末休み"
    SetHolidays "2010/12/30", "年末休み"
    SetHolidays "2010/12/31", "年末休み"
    SetHolidays "2011/1/1", "元旦"
    SetHolidays "2011/1/2", "年始休み"
    SetHolidays "2011/1/3", "年始休み"
    SetHolidays "2011/1/10", "成人の日"
    SetHolidays "2011/2/11", "建国記念の日"
    SetHolidays "2011/3/21", "春分の日"
    SetHolidays "2011/4/29", "昭和の日"
    '***********************************************************************************************
     
End Sub
 
 
 
Public Sub SetDateString(ByVal SomeDay As Date, Optional ByRef yyyy As String, Optional ByRef mm As String, Optional ByRef dd As String, Optional WeekDay As String)
'**************************************************************************************
'引数に指定された日付けを各引数(String型)に入れる。ついでに曜日も取得できる。
'例、"2009","05","09","月曜日"
'**************************************************************************************
    yyyy = Mid(Format(SomeDay, "yyyy"), 1, 4)
    mm = Mid(Format(SomeDay, "mm"), 1, 2)
    dd = Mid(Format(SomeDay, "dd"), 1, 2)
    WeekDay = GetWeekDay(SomeDay)
     
End Sub
 
Public Sub SetDateLong(ByVal SomeDay As Date, Optional ByRef yyyy As Long, Optional ByRef mm As Long, Optional ByRef dd As Long, Optional WeekDay As String)
'**************************************************************************************
'引数に指定された日付けを各引数(Long型)に入れる。ついでに曜日も取得できる。
'例、"2009","5","9","月曜日"
'**************************************************************************************
    yyyy = CLng(DatePart("yyyy", SomeDay))
    mm = CLng(DatePart("m", SomeDay))
    dd = CLng(DatePart("d", SomeDay))
    WeekDay = GetWeekDay(SomeDay)
     
End Sub
 
Public Function GetLastMonthDay(ByVal SomeDay As Date) As Long
'**************************************************************************************
'引数に指定された日付けの月の最終日を取得
'**************************************************************************************
    GetLastMonthDay = CLng(DatePart("d", DateAdd("d", -1, Format(DateAdd("m", 1, SomeDay), "yyyy/mm/01"))))
End Function
 
Public Function GetWeekDayCountOfMonth(ByVal SomeDay As Date) As Long
'**************************************************************************************
'指定された日付の曜日が第何週目かを取得する
'例、"2010年1月23" 第4土曜日なので戻り値は4
'**************************************************************************************
    GetWeekDayCountOfMonth = CLng(DatePart("d", SomeDay) / 7) + 1
End Function
 
Public Function IsHoliday(ByVal SomeDay As Date) As Boolean
'**************************************************************************************
'引数に指定された日が休日だとTrueを返します。Day_GetNationalHolidayNameと違い、土、日、祝日のどれか当てはまる場合Trueを返します。
'**************************************************************************************
 
    If GetWeekDay(SomeDay) = "土曜日" Or GetWeekDay(SomeDay) = "日曜日" Or IsNationalHoliday(SomeDay) = True Then
        IsHoliday = True
        Exit Function
    Else
        IsHoliday = IsNationalHoliday(SomeDay)
    End If
 
End Function
 
Public Function GetNationalHolidayName(ByVal SomeDay As Date) As String
'**************************************************************************************
'引数に指定された日の祝日名を取得します。引数の日が祝日じゃないとNULLを返します。
'**************************************************************************************
    Dim i As Long
     
    For i = 0 To UBound(NationalHolidays)
        If NationalHolidays(i).Days = SomeDay Then
            GetNationalHolidayName = NationalHolidays(i).Name
            Exit Function
        End If
    Next i
 
    GetNationalHolidayName = vbNullString
 
End Function
 
Public Function IsNationalHoliday(ByVal SomeDay As Date) As Boolean
'**************************************************************************************
'引数に指定された日が祝日だとTrueを返します。
'**************************************************************************************
     
    Dim i As Long
     
    For i = 0 To UBound(NationalHolidays)
        If NationalHolidays(i).Days = SomeDay Then
            IsNationalHoliday = True
            Exit Function
        End If
    Next i
     
    IsNationalHoliday = False
 
End Function
 
Public Function GetNextWorkDay(ByVal SomeDay As Date) As Date
'**************************************************************************************
'引数に指定された日付-1日からの翌営業日の日付を返す。指定日-1日しているので指定日が翌営業日なら指定日が返る
'翌営業日の判断基準は祝日でない平日。
'**************************************************************************************
 
    Dim tmp_Date As Date
    tmp_Date = SomeDay
    Do Until Me.IsHoliday(tmp_Date) = False
        tmp_Date = tmp_Date + 1
    Loop
    GetNextWorkDay = tmp_Date
End Function
 
 
Public Function GetWeekDay(ByVal SomeDay As Date) As String
'**************************************************************************************
'引数に指定された日付から曜日を取得し"月曜日"のような形式を返します。
'**************************************************************************************
 
    Dim myWeekDay As String
    myWeekDay = WeekDay(SomeDay)
     
    Select Case myWeekDay
        Case vbSunday: GetWeekDay = "日曜日"
        Case vbMonday: GetWeekDay = "月曜日"
        Case vbTuesday: GetWeekDay = "火曜日"
        Case vbWednesday: GetWeekDay = "水曜日"
        Case vbThursday: GetWeekDay = "木曜日"
        Case vbFriday: GetWeekDay = "金曜日"
        Case vbSaturday: GetWeekDay = "土曜日"
    End Select
     
End Function
 
Public Function GetWeekDay_Simple(ByVal SomeDay As Date) As String
'**************************************************************************************
'引数に指定された日付から曜日を取得し"月"のような形式を返します。
'**************************************************************************************
    GetWeekDay_Simple = Left(GetWeekDay(SomeDay), 1)
End Function
 
 
Private Sub SetHolidays(Holiday As Date, HolidayName As String) '祝日を設定する
    Static i As Long
    ReDim Preserve NationalHolidays(i) As HOLIDAYINFO
    With NationalHolidays(i)
        .Name = HolidayName
        .Days = Holiday
    End With
    i = i + 1
End Sub