祝日・休日計算ライブラリ

Option Public
Option Declare

Const Calendar_JANUARY = 1
Const Calendar_FEBRUALY = 2
Const Calendar_MARCH = 3
Const Calendar_APRIL = 4
Const Calendar_MAY = 5
Const Calendar_JUNE = 6
Const Calendar_JULY = 7
Const Calendar_AUGUST = 8
Const Calendar_SEPTEMBER = 9
Const Calendar_OCTOBER = 10
Const Calendar_NOVEMBER = 11
Const Calendar_DECEMBER = 12

Const Calendar_SUNDAY = 1
Const Calendar_MONDAY = 2
Const Calendar_TUESDAY = 3
Const Calendar_WEDNESDAY = 4
Const Calendar_THURSDAY = 5
Const Calendar_FRIDAY = 6
Const Calendar_SATURDAY = 7

'// ワイルドカード
Const Calendar_EVERY = -1
%REM
	祝日休日計算ライブラリ
	Class JpHoliday
	Description: Comments for Class
%END REM
Public Class JpHoliday
	'// 祝日リストクラス
	Public publicHoliday As Holiday
	'// 祝日（ハッピーマンデー）リストクラス
	Public happyMonday As WeekHoliday
	'//	個別設定休日リストクラス
	Public localHoliday As Holiday
	'// 個別設定週休リストクラス
	Public weekHoliday As WeekHoliday
	'// 祝日休使用フラグ
	Private usePublicHoliday As boolean
	'// 週末休使用フラグ
	Private useWeekend As Boolean
	%REM
		Sub New
		Description: Comments for Sub
		@param	usePublicHoliday	祝日休有効 
		@param	useWeekend	週末休有効
	%END REM
	Sub New(usePublicHoliday As Boolean, useWeekend As Boolean)
		If ( usePublicHoliday) Then
			Set publicHoliday = New Holiday()
			Set happyMonday = New WeekHoliday()
		End If
		Set localHoliday = New Holiday()
		Set weekHoliday = New WeekHoliday()
		me.useWeekend = useWeekend
	End Sub
	%REM
		標準祝日(2018.12)読み込み
		Function setDefault
		Description: Comments for Function
	%END REM
	Public Function setDefault() As Boolean
		Call publicHoliday.setDefaultItems()
		Call weekHoliday.setDefaultItems()
	End Function
	%REM
		休日名取得（）
		Function getHolidayName
		Description: Comments for Function
	%END REM
	Public Function getHolidayName(calendarDate As NotesDateTime) As String
		Dim dateYear As Integer
		Dim dateMonth As Integer
		Dim dateDate As Integer
		Dim dateDayOfWeek As Integer
		dateYear = Year(calendarDate.lsLocalTime)
		dateMonth = Month(calendarDate.lsLocalTime)
		dateDate = Day(calendarDate.lsLocalTime)
		dateDayOfWeek = Weekday(calendarDate.lsLocalTime)

		getHolidayName = getPublicHolidayName(calendarDate)
		If (Len(getHolidayName) > 0) Then Exit Function
		getHolidayName = getTransferHolidayName(calendarDate)
		If (Len(getHolidayName) > 0) Then Exit Function
		
		getHolidayName = getHolidayItemName(calendarDate,localHoliday.Items)
		If (Len(getHolidayName) > 0) Then Exit Function
		getHolidayName = getWeekHolidayItemName(calendarDate,weekHoliday.Items)
		If (Len(getHolidayName) > 0) Then Exit Function

		If(me.useWeekend And (dateDayOfWeek=Calendar_SUNDAY Or dateDayOfWeek = Calendar_SATURDAY)) Then
			getHolidayName = "週末"
		End If		
	End Function
	%REM
		振替休日取得
		Function getTransferHolidayName
		Description: Comments for Function
	%END REM
	Private Function getTransferHolidayName(calendarDate As NotesDateTime) As String
		Dim dateYear As Integer
		Dim dateMonth As Integer
		Dim dateDate As Integer
		Dim dateDayOfWeek As Integer
		dateYear = Year(calendarDate.lsLocalTime)
		dateMonth = Month(calendarDate.lsLocalTime)
		dateDate = Day(calendarDate.lsLocalTime)
		dateDayOfWeek = Weekday(calendarDate.lsLocalTime)
		Dim previousDate As New NotesDateTime("")
		previousDate.localTime = DateNumber(dateYear,dateMonth,dateDate-1)
		
		Dim loopPreviousDate As New NotesDateTime("")
		loopPreviousDate.localTime = DateNumber(dateYear,dateMonth,dateDate-1)
		
		Dim nextDate As New NotesDateTime("")
		nextDate.localTime = DateNumber(dateYear,dateMonth,dateDate+1)
		
		'// 1986-2006の5月4日の特殊処理
		If(1986 <= dateYear And dateYear <= 2006 And dateMonth = 5 And dateDate = 4) Then
			If (dateDayOfWeek = Calendar_MONDAY) Then
				getTransferHolidayName = "振替休日"
				Exit Function
			End If
		End If
		
		Dim rangeStart As New NotesDateTime("")
		rangeStart.localTime = DateNumber(1973,4,12)
		Dim rangeEnd As New NotesDateTime("")
		rangeEnd.localTime = DateNumber(2006,12,31)
		If (calendarDate.timeDifference(rangeStart) >= 0 And calendarDate.timeDifference(rangeEnd)<=0) Then
			'// 前日が日曜かつ国民の祝日のとき本日は振替休日
			If (Weekday(previousDate.lsLocalTime) = Calendar_SUNDAY) And Len(getPublicHolidayName(previousDate) > 0) Then
				getTransferHolidayName = "振替休日"
				Exit Function
			End If
		End If
		If (Year(calendarDate.lsLocalTime)>=2007) Then
			'// 前日に国民の祝日が連続しており、その中に日曜が含まれるとき本日は振替休日
			Do While Len(getTransferHolidayName)=0
				If (Len(getPublicHolidayName(loopPreviousDate)) = 0) Then
					'// 前日が国民の祝日では無い場合は終了
					Exit Do
				End If
				If (Weekday(loopPreviousDate.lsLocalTime) = Calendar_SUNDAY) Then
					'// 前日が日曜の場合は終了
					getTransferHolidayName = "振替休日"
					Exit Function
				End If
				Call loopPreviousDate.adjustDay(-1)
			Loop
		End If
		
		If (1986 <= dateYear And dateYear <= 2006 And dateMonth = 5 And dateDate = 4) Then
			If (dateDayOfWeek >= Calendar_TUESDAY And dateDayOfWeek <= Calendar_SATURDAY) Then
				getTransferHolidayName = "国民の休日"
				Exit Function
			End If
		End If
		rangeStart.localTime = DateNumber(1985,12,27)
		If (calendarDate.timeDifference(rangeStart) >= 0) Then
			If Len(getPublicHolidayName(previousDate)) > 0 And Len(getPublicHolidayName(nextDate)) > 0 And dateDayOfWeek >= 3 And dateDayOfWeek <= 7 Then
				getTransferHolidayName = "国民の休日"
				Exit Function
			End If
		End If
		
	End Function
	%REM
		祝日取得（春分、秋分、ハッピーマンデー含む）
		Function getPublicHolifor Function
	%END REM
	Private Function getPublicHolidayName(calendarDate As NotesDateTime) As String
		Dim dateMonth As Integer
		Dim dateDate As Integer
		Dim dateYear As Integer
		dateMonth = Month(calendarDate.lsLocalTime)
		dateDate = Day(calendarDate.lsLocalTime)
		dateYear = Year(calendarDate.lsLocalTime)
		'// usePublicHolidayでもpublicHoliday.countが0なら無条件でdefaultを読み込む
		If (publicHoliday.count = 0) Then Call publicHoliday.setDefaultItems()
		getPublicHolidayName = getHolidayItemName(calendarDate,publicHoliday.Items)
		If (Len(getPublicHolidayName) > 0) Then Exit Function
		'// usePublicHolidayでもhappyMonday.countが0なら無条件でdefaultを読み込む
		If (happyMonday.count = 0) Then Call happyMonday.setDefaultItems()
		getPublicHolidayName = getWeekHolidayItemName(calendarDate,happyMonday.Items)
		If (Len(getPublicHolidayName) > 0) Then Exit Function

		'// 春分・秋分
		If(1851<=dateYear And dateYear<=1899) Then
			If(dateMonth = 3 And dateDate = CInt(19.8277+0.242194*(dateYear-1980)-cint((dateYear-1983)/4))) Then
				getPublicHolidayName = "春分の日"
				Exit Function
			End If
			If(dateMonth = 9 And dateDate = CInt(22.2588+0.242194*(dateYear-1980)-cint((dateYear-1983)/4))) Then
				getPublicHolidayName = "秋分の日"
				Exit Function
			End If
		ElseIf(1900<=dateYear And dateYear<=1979) Then
			If(dateMonth = 3 And dateDate = CInt(20.8357+0.242194*(dateYear-1980)-cint((dateYear-1983)/4))) Then
				getPublicHolidayName = "春分の日"
				Exit Function
			End If
			If(dateMonth = 9 And dateDate = CInt(23.2588+0.242194*(dateYear-1980)-cint((dateYear-1983)/4))) Then
				getPublicHolidayName = "秋分の日"
				Exit Function
			End If
		ElseIf (1980<=dateYear And dateYear<=2099) Then
			If(dateMonth = 3 And dateDate = CInt(20.8431+0.242194*(dateYear-1980)-cint((dateYear-1980)/4))) Then
				getPublicHolidayName = "春分の日"
				Exit Function
			End If
			If(dateMonth = 9 And dateDate = CInt(23.2488+0.242194*(dateYear-1980)-cint((dateYear-1980)/4))) Then
				getPublicHolidayName = "秋分の日"
				Exit Function
			End If
		ElseIf (2100<=dateYear And dateYear<=2150) Then
			If(dateMonth = 3 And dateDate = CInt(21.851 +0.242194*(dateYear-1980)-cint((dateYear-1980)/4))) Then
				getPublicHolidayName = "春分の日"
				Exit Function
			End If
			If(dateMonth = 9 And dateDate = CInt(24.2488+0.242194*(dateYear-1980)-cint((dateYear-1980)/4))) Then
				getPublicHolidayName = "秋分の日"
				Exit Function
			End If
		End If
	End Function
	
	%REM
		Function getHolidayItemName
		Description: Comments  Function
		@param	calendarDate
		@param	items
	%END REM
	Private Function getHolidayItemName(calendarDate As NotesDateTime,items As Variant) As String
		Dim dateMonth As Integer
		Dim dateDate As Integer
		Dim dateYear As Integer
		dateMonth = Month(calendarDate.lsLocalTime)
		dateDate = Day(calendarDate.lsLocalTime)
		dateYear = Year(calendarDate.lsLocalTime)
		ForAll item In items
			If (dateMonth = item.holidayMonth Or item.holidayMonth = Calendar_EVERY) And (dateDate = item.holidayDate) And (dateYear >= item.holidayYearStart Or item.holidayYearStart = Calendar_EVERY) And (dateYear <= item.holidayYearEnd Or item.holidayYearEnd = Calendar_EVERY) Then
				getHolidayItemName = item.holidayName
				Exit Function
			End If
		End ForAll
	End Function
	%REM
		Function getWeekHolidayItemName
		Description: Comments  Function
		@param	calendarDate
		@param	items
	%END REM
	Private Function getWeekHolidayItemName(calendarDate As NotesDateTime,items As Variant) As String
		Dim dateMonth As Integer
		Dim dateDayOfWeek As Integer
		Dim dateDayOfWeekInMonth As Integer
		Dim dateYear As Integer
		dateMonth = Month(calendarDate.lsLocalTime)
		dateDayOfWeek = Weekday(calendarDate.lsLocalTime)
		dateDayOfWeekInMonth = Fix((Day(calendarDate.lsLocalTime)-1)/7)+1
		dateYear = Year(calendarDate.lsLocalTime)
		ForAll item In items
			If (dateMonth = item.holidayMonth Or item.holidayMonth = Calendar_EVERY) And (dateDayOfWeek = item.holidayDayOfWeek) And (dateDayOfWeekInMonth = item.holidayDayOfWeekInMonth Or item.holidayDayOfWeekInMonth = Calendar_EVERY) And (dateYear >= item.holidayYearStart Or item.holidayYearStart = Calendar_EVERY) And (dateYear <= item.holidayYearEnd Or item.holidayYearEnd = Calendar_EVERY) Then
				getWeekHolidayItemName = item.holidayName
				Exit Function
			End If
		End ForAll
	End Function
End Class
%REM
	Class Holiday
	Description: Comments for Class
%END REM
Class Holiday
	Public Items() As Variant
	Public count As Integer
	%REM
		Sub New
		Description: Comments for Sub
	%END REM
	
	Sub New()
		Me.count = 0
	End Sub
	%REM
		Function addItem
		Description: Comments  Function
		@param	holidayMonth
		@param	holidayDate
		@param	holidayYearStart
		@param	holidayYearEnd
		@param	holidayhoidayName
	%END REM
	Public Function addItem(holidayMonth As Integer, holidayDate As Integer, holidayYearStart As Integer, holidayYearEnd As Integer, holidayhoidayName As String) As Boolean
		ReDim Preserve me.Items(me.count)
		Set me.Items(me.count) = New HolidayItem(holidayMonth, holidayDate, holidayYearStart, holidayYearEnd, holidayhoidayName)
		me.count = me.count + 1 
		addItem = true
	End Function
	%REM
		Function setDefaultItems
		Description: Comments  Function
	%END REM
	
	'/ 標準祝日リスト（2018.12)
	Public Function setDefaultItems() As Boolean
		Call addItem(Calendar_JANUARY,1,1949,Calendar_EVERY,"元旦")
		Call addItem(Calendar_JANUARY,15,1949,1999,"成人の日")
		Call addItem(Calendar_FEBRUALY,11,1949,Calendar_EVERY,"建国記念の日")
		Call addItem(Calendar_FEBRUALY,23,2020,Calendar_EVERY,"天皇誕生日")
		Call addItem(Calendar_FEBRUALY,24,1989,1989,"昭和天皇の大喪の礼")
		Call addItem(Calendar_APRIL,10,1959,1959,"皇太子・明仁親王の結婚の儀")
		Call addItem(Calendar_APRIL,29,1949,1988,"天皇誕生日")
		Call addItem(Calendar_APRIL,29,1989,2006,"みどりの日")
		Call addItem(Calendar_APRIL,29,2007,Calendar_EVERY,"昭和の日")
		Call addItem(Calendar_MAY,1,2019,2019,"即位の日")
		Call addItem(Calendar_MAY,3,1949,Calendar_EVERY,"憲法記念日")
		Call addItem(Calendar_MAY,4,2007,Calendar_EVERY,"みどりの日")
		Call addItem(Calendar_MAY,5,1949,Calendar_EVERY,"こどもの日")
		Call addItem(Calendar_JUNE,9,1993,1993,"皇太子・皇太子徳仁親王の結婚の儀")
		Call addItem(Calendar_JULY,20,1996,2002,"海の日")
		Call addItem(Calendar_JULY,23,2020,2020,"海の日")
		Call addItem(Calendar_JULY,24,2020,2020,"スポーツの日")
		Call addItem(Calendar_AUGUST,11,2016,2019,"山の日")
		Call addItem(Calendar_AUGUST,10,2020,2020,"山の日")
		Call addItem(Calendar_AUGUST,11,2021,Calendar_EVERY,"山の日")
		Call addItem(Calendar_SEPTEMBER,15,1966,2002,"敬老の日")
		Call addItem(Calendar_OCTOBER,10,1966,1999,"体育の日")
		Call addItem(Calendar_OCTOBER,22,2019,2019,"即位礼正殿の儀")
		Call addItem(Calendar_NOVEMBER,3,1948,Calendar_EVERY,"文化の日")
		Call addItem(Calendar_NOVEMBER,12,1990,1990,"即位の礼正殿の儀")
		Call addItem(Calendar_NOVEMBER,23,1948,Calendar_EVERY,"勤労感謝の日")
		Call addItem(Calendar_DECEMBER,23,1989,2018,"天皇誕生日")
		setDefaultItems = true
	End Function
End Class
%REM
	Class HolidayItem
	Description: Comments for Class
%END REM

Class HolidayItem
    Public holidayMonth As Integer
	Public holidayDate As Integer
	Public holidayYearStart As Integer
	Public holidayYearEnd As Integer
	Public holidayName As String
	%REM
		Sub New
		Description: Comments for Sub
		@param	holidayMonth
		@param	holidayDate
		@param	holidayYearStart
		@param	holidayYearEnd
		@param	holidayName
	%END REM
	
    Sub New( holidayMonth As Integer, holidayDate As Integer, holidayYearStart As Integer, holidayYearEnd As Integer, holidayName As String)
        Me.holidayMonth = holidayMonth
        Me.holidayDate = holidayDate
        Me.holidayYearStart = holidayYearStart
        Me.holidayYearEnd = holidayYearEnd
        Me.holidayName = holidayName
    End Sub
End Class
%REM
	Class WeekHoliday
	Description: Comments for Class
%END REM
Class WeekHoliday
    Public Items() As Variant
    Public count As Integer
	%REM
		Sub New
		Description: Comments for Sub
	%END REM
    Sub New()
        Me.count = 0
    End Sub
	%REM
		Function addItem
		Description: Comments for function
		@param	holidayMonth
		@param	holidayDayOfWeek
		@param	holidayDayOfWeekInMonth
		@param	holidayYearStart
		@param	holidayYearEnd
		@param	holidayName
	%END REM
    Public Function addItem(holidayMonth As Integer, holidayDayOfWeek As Integer, holidayDayOfWeekInMonth As Integer, holidayYearStart As Integer, holidayYearEnd As Integer, holidayName As String) As Boolean
        ReDim Preserve me.Items(me.count)
        Set me.Items(me.count) = New WeekHolidayItem(holidayMonth, holidayDayOfWeek, holidayDayOfWeekInMonth, holidayYearStart, holidayYearEnd, holidayName)
        me.count = me.count + 1
	    addItem = true
    End Function
	%REM
		Function setDefaultItems
		Description: Comments for function
		@param	holidayMonth
		@param	holidayDayOfWeek
		@param	holidayDayOfWeekInMonth
		@param	holidayYearStart
		@param	holidayYearEnd
		@param	holidayName
	%END REM
    '// 標準ハッピーマンデーリスト（2018.12)
    Public Function setDefaultItems() As Boolean
        Call addItem(Calendar_JANUARY,2,2,2000,Calendar_EVERY,"成人の日")
        Call addItem(Calendar_JULY,2,3,2003,2019,"海の日")
        Call addItem(Calendar_JULY,2,3,2021,Calendar_EVERY,"海の日")
        Call addItem(Calendar_SEPTEMBER,2,3,2003,Calendar_EVERY,"敬老の日")
        Call addItem(Calendar_OCTOBER,2,2,2000,2019,"体育の日")
        Call addItem(Calendar_OCTOBER,2,2,2021,Calendar_EVERY,"スポーツの日") 
	    setDefaultItems = true
    End Function
End Class
%REM
	Class WeekHolidayItem
	Description: Comments for Class
%END REM
Class WeekHolidayItem
	Public holidayMonth As Integer
	Public holidayDayOfWeek As Integer
	Public holidayDayOfWeekInMonth As Integer
	Public holidayYearStart As Integer
	Public holidayYearEnd As Integer
	Public holidayName As String
	%REM
		Sub New
		Description: Comments for sub
		@param	holidayMonth
		@param	holidayDayOfWeek
		@param	holidayDayOfWeekInMonth
		@param	holidayYearStart
		@param	holidayYearEnd
		@param	holidayName
	%END REM
    Sub New( holidayMonth As Integer, holidayDayOfWeek As Integer, holidayDayOfWeekInMonth As Integer, holidayYearStart As Integer, holidayYearEnd As Integer, holidayName As String)
        Me.holidayMonth = holidayMonth
        Me.holidayDayOfWeek = holidayDayOfWeek
        Me.holidayDayOfWeekInMonth = holidayDayOfWeekInMonth
        Me.holidayYearStart = holidayYearStart
        Me.holidayYearEnd = holidayYearEnd
        Me.holidayName = holidayName
    End Sub
End Class
%REM
	Sub testHoliday
	Description: Comments for Sub
%END REM
Public Sub testHoliday()
	Dim uiws As New NotesUIWorkspace
	Dim f As Integer
	Dim fName As Variant
	Dim weekdayLabel As variant 
	Dim objShell As Variant
	Set objShell = createObject("WSCRIPT.SHELL")
	fName = uiws.saveFileDialog(False,"名前を付けて保存","plain text|*.txt",objShell.specialFolders("MYDOCUMENTS"),"")
	If IsEmpty(fName) Then Exit Sub
	f = FreeFile()
	Open fName(0) For Output As f
	weekdayLabel = Split(",(日),(月),(火),(水),(木),(金),(土)",",")
	Dim minYear As Integer
	Dim maxYear As Integer
	'// 祝日休と週末休を有効に
	Dim jpHoliday As New JpHoliday(True,True)
	'// 個別設定休日を追加
	Call JpHoliday.localHoliday.addItem(Calendar_JANUARY,2,Calendar_EVERY, Calendar_EVERY,"年始")
	Call JpHoliday.localHoliday.addItem(Calendar_JANUARY,3,Calendar_EVERY, Calendar_EVERY,"年始")
	Call JpHoliday.localHoliday.addItem(Calendar_DECEMBER,29,Calendar_EVERY, Calendar_EVERY,"年末")
	Call JpHoliday.localHoliday.addItem(Calendar_DECEMBER,30,Calendar_EVERY, Calendar_EVERY,"年末")
	Call JpHoliday.localHoliday.addItem(Calendar_DECEMBER,31,Calendar_EVERY, Calendar_EVERY,"年末")
	'// 個別設定週休
'	Call jpHoliday.weekHoliday.addItem(Calendar_EVERY,Calendar_WEDNESDAY,Calendar_EVERY,Calendar_EVERY,Calendar_EVERY,"定休日")
	Dim i As Integer
	Dim calDate As New NotesDateTime("")
	minYear = Year(Now)-5
	maxYear = Year(Now)+5
	calDate.localTime = DateNumber(minYear,1,1)
	While Year(calDate.lslocaltime) <= maxYear
		Print #f,Format(calDate.localTime,"yyyy/MM/dd")+Chr(9)+ weekdayLabel(Weekday(calDate.localTime)) +Chr(9) + jpHoliday.getHolidayName(calDate)
		Call calDate.adjustday(1)
	Wend
	Close f
End Sub

Select XSnippet to copy to Clipboard