カレンダーの休日設定
文書番号 : 36905
文書種別 : 使用方法
登録日 : 2013/12/26
最終更新日 : 2014/06/06
対象製品
InputMan Pro 7.0J
詳細
カレンダーコントロールでは、その年によって変動する「ハッピーマンデー」や「春分の日」「秋分の日」また、2016年以降に施行される「山の日」は、日付を追加するだけでは毎年の休日として登録されません。よってアプリケーション側の対応が必要となります。
以下は、カレンダーコントロールの祝日（2014年6月現在）の設定例です。
◆サンプルコード
以下は、カレンダーコントロールの祝日（2014年6月現在）の設定例です。
◆サンプルコード
'カレンダーの年を調べるための変数
Dim iYear As Integer, iYear2 As Integer, iPreYear As Integer
'カレンダーのスクロールを調べるための変数
Dim dtStart As Date
Private Sub Form_Load()
iYear = year(Date) '現在の年をセットする
dtStart = Date
iYear2 = year(DateTime.DateAdd("YYYY", 1, Date)) '翌年の年をセットする
SetStyles 'カレンダーのスタイルと従来通りの休日を設定
SetHoliday 'ハッピーマンデーを設定
SetEquinoxDay '春分の日と秋分の日を設定
SetNewHoliday '山の日を設定
iPreYear = iYear '現在のカレンダーの年を保存する
End Sub
Private Sub SetHoliday()
'成人の日、体育の日、海の日、敬老の日の設定
With imCalendar1
If iYear < 2003 Then '2002年以前なら従来の祝日設定
.HolidayStyles.Add , "TNH" 'Traditional National Holiday
With .HolidayStyles("TNH")
.Override = imOverrideNextDay '休日振替
.Days.Add "7/20", "海の日", CDate(iYear & "/7/20")
.Days.Add "9/15", "敬老の日", CDate(iYear & "/9/15")
If iYear < 2000 Then '1999年以前なら従来の祝日設定
.Days.Add "1/15", "成人の日", CDate(iYear & "/1/15")
.Days.Add "10/10", "体育の日", CDate(iYear & "/10/10")
Else '2000年以降なら新祝日法に基づく祝日設定
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear & "/1/1"))
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear & "/10/1"))
End If
.ForeColor = vbRed
End With
.UseStyles = "NH,TNH"
Else '2003年以降なら新祝日法に基づく祝日設定
.HolidayStyles.Add , "NNH"
With .HolidayStyles("NNH")
.Override = imOverrideNextDay '休日振替
If dtStart <= CDate(iYear & "/1/1") Then
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear & "/1/1"))
Else
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear2 & "/1/1"))
End If
If dtStart <= CDate(iYear & "/10/1") Then
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear & "/10/1"))
Else
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear2 & "/10/1"))
End If
If dtStart <= CDate(iYear & "/7/1") Then
.Days.Add "7/20", "海の日", CalcHoliday2(CDate(iYear & "/7/1"))
Else
.Days.Add "7/20", "海の日", CalcHoliday2(CDate(iYear2 & "/7/1"))
End If
If dtStart <= CDate(iYear & "/9/1") Then
.Days.Add "9/15", "敬老の日", CalcHoliday2(CDate(iYear & "/9/1"))
Else
.Days.Add "9/15", "敬老の日", CalcHoliday2(CDate(iYear2 & "/9/1"))
End If
.ForeColor = vbRed
End With
.UseStyles = "NH,NNH"
End If
.Redraw = True
End With
End Sub
Private Sub SetEquinoxDay()
' 1900年から2099年までを対象としています。
' この範囲を超えた年については、便宜的に2013年の設定を使用します。
Dim strSpring As String
Dim strAutumn As String
If iYear > 1899 And iYear < 2100 Then
Select Case iYear Mod 4
Case 0
' 春分の日を設定します。
If iYear < 1960 Then
strSpring = "3/21"
ElseIf iYear >= 1960 And iYear < 2092 Then
strSpring = "3/20"
Else
strSpring = "3/19"
End If
' 秋分の日を設定します。
If iYear < 2012 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 1
' 春分の日を設定します。
If iYear < 1993 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1921 Then
strAutumn = "9/24"
ElseIf iYear >= 1921 And iYear < 2045 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 2
' 春分の日を設定します。
If iYear < 2026 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1950 Then
strAutumn = "9/24"
ElseIf iYear >= 1950 And iYear < 2078 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 3
' 春分の日を設定します。
If (iYear < 1927) Then
strSpring = "3/22"
ElseIf iYear >= 1927 And iYear < 2059 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1983 Then
strAutumn = "9/24"
Else
strAutumn = "9/23"
End If
End Select
' 2つの祝日に挟まれた営業日を休日に設定します。
If iYear > 2003 Then
Dim syubun As Date
syubun = CDate(iYear & "/" & strAutumn)
If Weekday(syubun) = 4 Then
syubun = DateAdd("d", -1, syubun)
imCalendar1.HolidayStyles("NNH").Days.Add Month(syubun) & "/" & Day(syubun), , syubun
End If
End If
Else
' 2013年の春分の日を設定します。
strSpring = "3/20"
' 2013年の秋分の日を設定します。
strAutumn = "9/23"
End If
With imCalendar1
With .HolidayStyles("NNH")
.Override = imOverrideNextDay
.Days.Add strSpring, "春分の日", CDate(iYear & "/" & strSpring)
.Days.Add strAutumn, "秋分の日", CDate(iYear & "/" & strAutumn)
.ForeColor = vbRed
End With
.UseStyles = "NH,NNH"
.Redraw = True
End With
End Sub
Private Sub SetNewHoliday()
'2016年以降に山の日（8月11日）を設定。
If iYear > 2015 Then
With imCalendar1
.HolidayStyles("NNH").Days.Add "8/11", "山の日", CDate(iYear & "/8/11")
.Redraw = True
End With
End If
End Sub
Private Sub SetStyles()
'カレンダーのスタイルを設定する
With imCalendar1
.Redraw = False
'AttribStyleの設定
With .AttribStyles
.Add , "Sun"
.Add , "Sat"
End With
'日曜日のスタイル
.AttribStyles("Sun").ForeColor = vbRed
'土曜日のスタイル
.AttribStyles("Sat").ForeColor = vbBlue
.WeekDays(1).Attribute = "Sun"
.WeekRests(1) = imAllWeeks
.WeekDays(1).ReflectToTitle = imReflectForeColor
.WeekDays(7).Attribute = "Sat"
.WeekRests(7) = imAllWeeks
.WeekDays(7).ReflectToTitle = imReflectForeColor
.HolidayStyles.Add , "NH" 'National Holiday のスタイル
With .HolidayStyles("NH")
.Override = imOverrideNextDay '休日振替
.Days.Add "1/1", "元旦", CDate(iYear & "/1/1")
.Days.Add "2/11", "建国記念日", CDate(iYear & "/2/11")
.Days.Add "4/29", "みどりの日", CDate(iYear & "/4/29")
.Days.Add "5/3", "憲法記念日", CDate(iYear & "/5/3")
.Days.Add "5/4", "国民の休日", CDate(iYear & "/5/4")
.Days.Add "5/5", "こどもの日", CDate(iYear & "/5/5")
.Days.Add "11/3", "文化の日", CDate(iYear & "/11/3")
.Days.Add "11/23", "勤労感謝の日", CDate(iYear & "/11/23")
.Days.Add "12/23", "天皇誕生日", CDate(iYear & "/12/23")
.ForeColor = vbRed
End With
End With
End Sub
Private Function CalcHoliday(dtHoliday As Date) As Date
'新祝日法に基づく祝日の算出
Dim iWeekDay As Integer
Dim lNum As Long
iWeekDay = Weekday(dtHoliday) '対象日(1/1,10/1)の曜日を調べる
lNum = 2 - iWeekDay '第2月曜日までの日数計算
If iWeekDay < 3 Then
lNum = lNum + 7
Else
lNum = lNum + 14
End If
CalcHoliday = DateAdd("d", lNum, dtHoliday) '月曜日の日付を算出
End Function
Private Function CalcHoliday2(dtHoliday As Date) As Date
'新祝日法に基づく祝日の算出
Dim iWeekDay As Integer
Dim lNum As Long
iWeekDay = Weekday(dtHoliday) '対象日(7/1,9/1)の曜日を調べる
lNum = 2 - iWeekDay '第3月曜日までの日数計算
If iWeekDay < 3 Then
lNum = lNum + 14
Else
lNum = lNum + 21
End If
CalcHoliday2 = DateAdd("d", lNum, dtHoliday) '月曜日の日付を算出
End Function
Private Sub imCalendar1_Scroll(StartDate As Date, EndDate As Date)
dtStart = StartDate
'表示されたカレンダーの年を取得
iYear = year(StartDate)
iYear2 = year(EndDate)
'カレンダーの年が変わったらスタイルを変更する
If iYear <> iPreYear Or iYear <> iYear2 Then
imCalendar1.Redraw = False
'スタイル"NNH"を削除
imCalendar1.HolidayStyles.Remove "NNH"
' ハッピーマンデーの再設定
SetHoliday
' 春分の日と秋分の日の再設定
SetEquinoxDay
' 山の日の再設定
SetNewHoliday
End If
iPreYear = iYear '新しく表示されたカレンダーの年を保存
End Sub
Dim iYear As Integer, iYear2 As Integer, iPreYear As Integer
'カレンダーのスクロールを調べるための変数
Dim dtStart As Date
Private Sub Form_Load()
iYear = year(Date) '現在の年をセットする
dtStart = Date
iYear2 = year(DateTime.DateAdd("YYYY", 1, Date)) '翌年の年をセットする
SetStyles 'カレンダーのスタイルと従来通りの休日を設定
SetHoliday 'ハッピーマンデーを設定
SetEquinoxDay '春分の日と秋分の日を設定
SetNewHoliday '山の日を設定
iPreYear = iYear '現在のカレンダーの年を保存する
End Sub
Private Sub SetHoliday()
'成人の日、体育の日、海の日、敬老の日の設定
With imCalendar1
If iYear < 2003 Then '2002年以前なら従来の祝日設定
.HolidayStyles.Add , "TNH" 'Traditional National Holiday
With .HolidayStyles("TNH")
.Override = imOverrideNextDay '休日振替
.Days.Add "7/20", "海の日", CDate(iYear & "/7/20")
.Days.Add "9/15", "敬老の日", CDate(iYear & "/9/15")
If iYear < 2000 Then '1999年以前なら従来の祝日設定
.Days.Add "1/15", "成人の日", CDate(iYear & "/1/15")
.Days.Add "10/10", "体育の日", CDate(iYear & "/10/10")
Else '2000年以降なら新祝日法に基づく祝日設定
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear & "/1/1"))
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear & "/10/1"))
End If
.ForeColor = vbRed
End With
.UseStyles = "NH,TNH"
Else '2003年以降なら新祝日法に基づく祝日設定
.HolidayStyles.Add , "NNH"
With .HolidayStyles("NNH")
.Override = imOverrideNextDay '休日振替
If dtStart <= CDate(iYear & "/1/1") Then
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear & "/1/1"))
Else
.Days.Add "1/15", "成人の日", CalcHoliday(CDate(iYear2 & "/1/1"))
End If
If dtStart <= CDate(iYear & "/10/1") Then
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear & "/10/1"))
Else
.Days.Add "10/10", "体育の日", CalcHoliday(CDate(iYear2 & "/10/1"))
End If
If dtStart <= CDate(iYear & "/7/1") Then
.Days.Add "7/20", "海の日", CalcHoliday2(CDate(iYear & "/7/1"))
Else
.Days.Add "7/20", "海の日", CalcHoliday2(CDate(iYear2 & "/7/1"))
End If
If dtStart <= CDate(iYear & "/9/1") Then
.Days.Add "9/15", "敬老の日", CalcHoliday2(CDate(iYear & "/9/1"))
Else
.Days.Add "9/15", "敬老の日", CalcHoliday2(CDate(iYear2 & "/9/1"))
End If
.ForeColor = vbRed
End With
.UseStyles = "NH,NNH"
End If
.Redraw = True
End With
End Sub
Private Sub SetEquinoxDay()
' 1900年から2099年までを対象としています。
' この範囲を超えた年については、便宜的に2013年の設定を使用します。
Dim strSpring As String
Dim strAutumn As String
If iYear > 1899 And iYear < 2100 Then
Select Case iYear Mod 4
Case 0
' 春分の日を設定します。
If iYear < 1960 Then
strSpring = "3/21"
ElseIf iYear >= 1960 And iYear < 2092 Then
strSpring = "3/20"
Else
strSpring = "3/19"
End If
' 秋分の日を設定します。
If iYear < 2012 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 1
' 春分の日を設定します。
If iYear < 1993 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1921 Then
strAutumn = "9/24"
ElseIf iYear >= 1921 And iYear < 2045 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 2
' 春分の日を設定します。
If iYear < 2026 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1950 Then
strAutumn = "9/24"
ElseIf iYear >= 1950 And iYear < 2078 Then
strAutumn = "9/23"
Else
strAutumn = "9/22"
End If
Case 3
' 春分の日を設定します。
If (iYear < 1927) Then
strSpring = "3/22"
ElseIf iYear >= 1927 And iYear < 2059 Then
strSpring = "3/21"
Else
strSpring = "3/20"
End If
' 秋分の日を設定します。
If iYear < 1983 Then
strAutumn = "9/24"
Else
strAutumn = "9/23"
End If
End Select
' 2つの祝日に挟まれた営業日を休日に設定します。
If iYear > 2003 Then
Dim syubun As Date
syubun = CDate(iYear & "/" & strAutumn)
If Weekday(syubun) = 4 Then
syubun = DateAdd("d", -1, syubun)
imCalendar1.HolidayStyles("NNH").Days.Add Month(syubun) & "/" & Day(syubun), , syubun
End If
End If
Else
' 2013年の春分の日を設定します。
strSpring = "3/20"
' 2013年の秋分の日を設定します。
strAutumn = "9/23"
End If
With imCalendar1
With .HolidayStyles("NNH")
.Override = imOverrideNextDay
.Days.Add strSpring, "春分の日", CDate(iYear & "/" & strSpring)
.Days.Add strAutumn, "秋分の日", CDate(iYear & "/" & strAutumn)
.ForeColor = vbRed
End With
.UseStyles = "NH,NNH"
.Redraw = True
End With
End Sub
Private Sub SetNewHoliday()
'2016年以降に山の日（8月11日）を設定。
If iYear > 2015 Then
With imCalendar1
.HolidayStyles("NNH").Days.Add "8/11", "山の日", CDate(iYear & "/8/11")
.Redraw = True
End With
End If
End Sub
Private Sub SetStyles()
'カレンダーのスタイルを設定する
With imCalendar1
.Redraw = False
'AttribStyleの設定
With .AttribStyles
.Add , "Sun"
.Add , "Sat"
End With
'日曜日のスタイル
.AttribStyles("Sun").ForeColor = vbRed
'土曜日のスタイル
.AttribStyles("Sat").ForeColor = vbBlue
.WeekDays(1).Attribute = "Sun"
.WeekRests(1) = imAllWeeks
.WeekDays(1).ReflectToTitle = imReflectForeColor
.WeekDays(7).Attribute = "Sat"
.WeekRests(7) = imAllWeeks
.WeekDays(7).ReflectToTitle = imReflectForeColor
.HolidayStyles.Add , "NH" 'National Holiday のスタイル
With .HolidayStyles("NH")
.Override = imOverrideNextDay '休日振替
.Days.Add "1/1", "元旦", CDate(iYear & "/1/1")
.Days.Add "2/11", "建国記念日", CDate(iYear & "/2/11")
.Days.Add "4/29", "みどりの日", CDate(iYear & "/4/29")
.Days.Add "5/3", "憲法記念日", CDate(iYear & "/5/3")
.Days.Add "5/4", "国民の休日", CDate(iYear & "/5/4")
.Days.Add "5/5", "こどもの日", CDate(iYear & "/5/5")
.Days.Add "11/3", "文化の日", CDate(iYear & "/11/3")
.Days.Add "11/23", "勤労感謝の日", CDate(iYear & "/11/23")
.Days.Add "12/23", "天皇誕生日", CDate(iYear & "/12/23")
.ForeColor = vbRed
End With
End With
End Sub
Private Function CalcHoliday(dtHoliday As Date) As Date
'新祝日法に基づく祝日の算出
Dim iWeekDay As Integer
Dim lNum As Long
iWeekDay = Weekday(dtHoliday) '対象日(1/1,10/1)の曜日を調べる
lNum = 2 - iWeekDay '第2月曜日までの日数計算
If iWeekDay < 3 Then
lNum = lNum + 7
Else
lNum = lNum + 14
End If
CalcHoliday = DateAdd("d", lNum, dtHoliday) '月曜日の日付を算出
End Function
Private Function CalcHoliday2(dtHoliday As Date) As Date
'新祝日法に基づく祝日の算出
Dim iWeekDay As Integer
Dim lNum As Long
iWeekDay = Weekday(dtHoliday) '対象日(7/1,9/1)の曜日を調べる
lNum = 2 - iWeekDay '第3月曜日までの日数計算
If iWeekDay < 3 Then
lNum = lNum + 14
Else
lNum = lNum + 21
End If
CalcHoliday2 = DateAdd("d", lNum, dtHoliday) '月曜日の日付を算出
End Function
Private Sub imCalendar1_Scroll(StartDate As Date, EndDate As Date)
dtStart = StartDate
'表示されたカレンダーの年を取得
iYear = year(StartDate)
iYear2 = year(EndDate)
'カレンダーの年が変わったらスタイルを変更する
If iYear <> iPreYear Or iYear <> iYear2 Then
imCalendar1.Redraw = False
'スタイル"NNH"を削除
imCalendar1.HolidayStyles.Remove "NNH"
' ハッピーマンデーの再設定
SetHoliday
' 春分の日と秋分の日の再設定
SetEquinoxDay
' 山の日の再設定
SetNewHoliday
End If
iPreYear = iYear '新しく表示されたカレンダーの年を保存
End Sub