Excelブックは「複製」をいくらでも作ることができます。
「複製」そのものは防御できません。
前のページまでは、祝日ロジックをプログラミングではなく「パラメータ」として投入できるようにして、
プログラム技術者ではなくても祝日の変更についてメンテナンスができるようにする、というところにフォーカスを当てた説明をしてきました。
中では「配布の問題」が発生するという説明を折々に入れてはきましたが、 「じゃあどうするの？」という件については「まずはバージョン管理」という説明に止めています。 「配布の問題」をご覧の方は意識してプログラム部分をアドインに移すとかを考えていただけると思いますが、 プログラムとしても初心者では難しい領域のことになるでしょう。
「配布の問題」で説明している本来の趣旨は「プログラムによる仕組みの動作レベルの均質化」なのですが、 「祝日パラメータ」のことについて考えると、プログラムが同一であっても異なる結果が出ることになりかねないということがあります。
これは「祝日パラメータシート」方式であっても、祝日処理ロジックが書き込まれた「従来方式マクロ」が仕込まれたワークブックでも全く同じです。 古い仕様のワークブックがコピーされて新規に利用されることがいつまでも無くなりません。
そこで、ここでは祝日処理が入っているExcelブックが社内にばらまかれても、同じ「祝日パラメータ」で処理されるようにし、 さらにその一箇所にある「祝日パラメータ」を更新すれば社内の全部が最新の「祝日パラメータ」で処理されるようになるという方法を考えてみましょう。
中では「配布の問題」が発生するという説明を折々に入れてはきましたが、 「じゃあどうするの？」という件については「まずはバージョン管理」という説明に止めています。 「配布の問題」をご覧の方は意識してプログラム部分をアドインに移すとかを考えていただけると思いますが、 プログラムとしても初心者では難しい領域のことになるでしょう。
「配布の問題」で説明している本来の趣旨は「プログラムによる仕組みの動作レベルの均質化」なのですが、 「祝日パラメータ」のことについて考えると、プログラムが同一であっても異なる結果が出ることになりかねないということがあります。
これは「祝日パラメータシート」方式であっても、祝日処理ロジックが書き込まれた「従来方式マクロ」が仕込まれたワークブックでも全く同じです。 古い仕様のワークブックがコピーされて新規に利用されることがいつまでも無くなりません。
そこで、ここでは祝日処理が入っているExcelブックが社内にばらまかれても、同じ「祝日パラメータ」で処理されるようにし、 さらにその一箇所にある「祝日パラメータ」を更新すれば社内の全部が最新の「祝日パラメータ」で処理されるようになるという方法を考えてみましょう。
- 問題は「祝日パラメータ」をどこにどのような形態で配置するかです。
-
最低でも社内で全社から参照できる共有サーバがある必要があります。部署内で構わないのであれば部署内の共有サーバと考えて下さい。
「祝日パラメータシート」だけのワークブックを作成して、共有サーバ上に置いておく方法も考えられますが、単純なテキストファイルを読み込むのと比べるとレスポンスに影響が出るので、 テキストファイル形式の「祝日パラメータ」を読み込む方法として説明しています。
今回のサンプルはHTTPで接続するものも含めているのでWebサーバでも構いません。 Microsoftネットワークとしての「共有ファイルサーバ」だとすると、ログイン認証を通らないと内部のファイル等に到達できないという問題があるので、 匿名認証のWebサーバに配置できる方が運用上で安全だと思います。
カレンダー処理マクロを持つワークブック自体がその共有サーバ上に置かれているなどで共有サーバへのログイン認証が確立しているのであれば、共有サーバ上に配置する方法でも構いません。
サンプルではこういった環境の上に「祝日パラメータ」はテキストファイルとして配置します。
ファイルの中身は、
このような感じです。....*....1....*....2....*....3....*....4 0100100000009999元旦 0101500000001999成人の日 0110002120009999成人の日 0201100019679999建国記念の日 0202300020209999天皇誕生日 0390000000009999春分の日 0402900000001988天皇誕生日 0402900019892006みどりの日 0402900020079999昭和の日 0500100020192019新天皇即位の日 0500300000009999憲法記念日 0500410019862006国民の休日 0500400020079999みどりの日 0500500000009999こどもの日 0702000019962002海の日 0710003120032019海の日 0702300020202020海の日 0702200020212021海の日 0710003120229999海の日 0702400020202020スポーツの日 0702300020212021スポーツの日 0801100020162019山の日 0801000020202020山の日 0800800020212021山の日 0801100020229999山の日 0901500000002002敬老の日 0910003120039999敬老の日 0990000000009999秋分の日 1001000019661999体育の日 1010002120002019体育の日 1010002120229999スポーツの日 1002200020192019即位礼正殿の儀 1100300000009999文化の日 1102300000009999勤労感謝の日 1202300019892018天皇誕生日 ....*....1....*....2....*....3....*....4 この祝日パラメータ各行の内容 1,2桁目：月(01～12) 3桁目：処理区分(0=固定日､1=HappyMonday､2=会社休日､9=特殊) 4,5桁目：[固定日]日付(01～31) 6桁目：[固定日]振替有無(0=通常､1=振休無し) 7桁目：[HappyMonday]第n週 8桁目：[HappyMonday]曜日(1=月曜､月曜日以外不可) 9-12桁目：開始年(不明は0000) 13-16桁目：終了年(不明は9999) 17桁目以降：祝日名
（緑字部分は説明のための記述で実際のファイル上には記述されていません。）
(画像をクリックすると、このページのサンプルがダウンロードできます)
サンプルはこのように前頁と全く同じ動きをするもので、違うのは「祝日パラメータをどこから持ってくるのか」だけです。
サンプルのExcelワークブックを見ていただければ判りますが、祝日パラメータはシートとしても存在しないし、 前頁のようなソースコードの記述もありません。
ではサンプルではどこから祝日パラメータを読み込んでくるのかというと、当サイトのトップページレベルに置いてある「ExcelDeOshigotoHoliday.txt」 というテキストファイルから読み出しています。 ←このファイル名のところをクリックするとブラウザ上にそのファイルが開きます。
（このファイルの内容はあくまでサンプルとして利用して下さい。祝日についてのメンテナンスは保証いたしかねます）
テキストファイルというようなファイルで配置する以外に、SQLServerのようなデータベースにテーブルとして登録してしまう方法も考えられます。 私の勤務先の会社でもこの方法を採っており、その祝日パラメータを管理上でメンテナンスする仕組みも完備させていますが、 環境面で難しい場合が多くありサンプルとして適さないので紹介していません。
テキストファイルであれば事前にローカルPCなど他の場所で変更を行ない充分に検証してから配置すれば済むのでメンテナンス性が良く、 社内にあるWebサーバに配置できるなら、通常HTTP側からのアクセスは「読み取り専用」なので書き換えは発生しません。
逆に「共有ファイルサーバ」に配置する方法を採る場合は、ユーザー認証（認証を通過していないと祝日パラメータが読み出せない）の問題と、 ユーザー権限により管理者以外のユーザーからこの祝日パラメータが書き換えられないかという点に配慮する必要が発生します。
- 今回の仕組みの利用方法は？
-
この機能を利用中のワークブックでこれらを利用するためには、プロジェクトに以下のものを持ち込んで下さい。
機能の呼び出し方については、前ページ等のソースコードを参考にして下さい。オブジェクト 用途等 modAboutCalendar2DF クラスの初期化及び月間カレンダーテーブルのユーザー定義や公開プロシージャが収容されています。 前頁のmodAboutCalendar2Rと記述要件は変わらないのですが、呼び出しクラス名が変わったため名称も変更しています。
呼び出しクラス名以外は前頁のmodAboutCalendar2Rと全く同じです。clsAboutCalendar2DF 実際のカレンダー作成の全機能が収容されているクラスです。利用者プログラムから呼び出すことも可能ですが、上記の「modAboutCalendar2DF」が呼び出し部分を行なうようにしているので、 利用者プログラムでは意識しなくても良いようにしてあります。
先頭のモジュールレベルに祝日パラメータファイルのフルパス名が定数として登録されているので、必要の応じて変更して下さい。 このフルパス名が利用環境で一意になっていなくてはなりません。
祝日パラメータファイルが読み出せないことが考えられますが、この場合はシステムエラーメッセージと「※作成するカレンダーには祝日が反映されません。」が表示されて、 以降は祝日なしでカレンダー処理が行なわれます。
公開するモジュール(modAboutCalendar2DF)の公開プロシージャは以下の7つです。
プロシージャID 説明 GP_InitAboutCalendar カレンダー関連関数クラス初期化
[戻値]なし
[引数]なしGP_GetCalendarTable1 カレンダーテーブル作成(当月1ヶ月用)
[戻値]なし
[引数]①年
②月
③カレンダーテーブルが返される
※カレンダー関連関数クラスが初期化済でない時は本処理から初期化されるGP_GetCalendarTable1R カレンダーテーブル作成(当月1ヶ月用)
[戻値]なし
[引数]①年
②月
③カレンダーテーブルが返される
※カレンダー関連関数クラスが初期化済であること(本処理内では判定しない)GP_GetCalendarTable3 カレンダーテーブル作成(当月+前後の3ヶ月用)
[戻値]なし
[引数]①年
②月
③カレンダーテーブルが返される
④当月開始位置INDEXが返される(Option)
⑤当月終了位置INDEXが返される(Option)
※カレンダー関連関数クラスが初期化済でない時は本処理から初期化されるGP_GetCalendarTable3R カレンダーテーブル作成(当月+前後の3ヶ月用)
[戻値]なし
[引数]①年
②月
③カレンダーテーブルが返される
④当月開始位置INDEXが返される(Option)
⑤当月終了位置INDEXが返される(Option)
※カレンダー関連関数クラスが初期化済であること(本処理内では判定しない)GP_SumEigyoNissu 営業日数算出(土日祝日を除外)
[戻値]なし
[引数]①期間開始日
②期間終了日
③営業日数が返される
④歴日数が返される(Option)GP_SumEigyoBi 営業日数経過後営業日算出(土日祝日を除外)
[戻値]なし
[引数]①起算日
②経過営業日数(マイナス可)
③算出結果(営業日日付)が返される
- それではソースコードです。
-
では、「カレンダー関連呼び出しモジュール(modAboutCalendar2DF)」のソ－スコードです。
上の表にある各プロシージャが並んでいます。
先に説明した通りで前頁の「modAboutCalendar2R」と呼び出しクラス名が「clsAboutCalendar2R」から「clsAboutCalendar2DF」に替わっただけです。
'*************************************************************************************************** ' カレンダー関連関数(クラス呼び出し部分) modAboutCalendar2DF(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' ※カレンダー関連関数の主要部分はクラス(clsAboutCalendar2DF)側に実装されている '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '18/09/17(1.70)新規作成 '18/09/23(1.71)クラス初期化判定を行なわないプロシージャを追加(連続呼び出し用) '18/12/18(1.80)祝日パラメータをファイルから読み込む方式として新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== ' 祝日含むカレンダーテーブル用ユーザー定義(公開) Public Type g_typAboutCalendar2 Hiduke As Date ' 日付 Yobi As Long ' 曜日(0=日､1=月､2=火～6=土) Syusu As Long ' 週数(1始まりで日曜日発見時に1加算) HmSyusu As Long ' 週数(0始まりで月曜日発見時に1加算) ※祝日法(HM)対応 Syuku As Long ' 祝日判定(0=通常､1=祝日､2=振替休日､3=会社休日) SyukuNm As String ' 祝日名称 FurikaeKbn As Long ' 振替区分(0=通常､1=振替休日を行なわない) End Type '--------------------------------------------------------------------------------------------------- ' カレンダー関連関数クラス Public g_clsAboutCalendar As clsAboutCalendar2DF ' カレンダー関連関数クラス Private g_blnInitAboutCalendar As Boolean ' カレンダー関連関数クラス初期化判定 ' [注]VBAではモジュール保持変数の｢保持｣は保証されない '*************************************************************************************************** ' ■■■ 公開プロシージャ(Public) ■■■ '*************************************************************************************************** '* 処理名 ：GP_InitAboutCalendar '* 機能 ：カレンダー関連関数クラス初期化 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月23日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：初期化済みの場合はスキップされる '*************************************************************************************************** Public Sub GP_InitAboutCalendar() '----------------------------------------------------------------------------------------------- ' 未初期化なら初期化を行なう If Not g_blnInitAboutCalendar Then ' カレンダー関連関数クラスを初期化(クラス側で祝日パラメータテーブルが作成される) Set g_clsAboutCalendar = New clsAboutCalendar2DF g_blnInitAboutCalendar = True End If End Sub '*************************************************************************************************** '* 処理名 ：GP_GetCalendarTable1 '* 機能 ：カレンダーテーブル作成(当月1ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Public Sub GP_GetCalendarTable1(ByVal lngY As Long, _ ByVal lngM As Long, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- ' カレンダー関連関数クラス初期化 Call GP_InitAboutCalendar ' カレンダーテーブル作成(当月分) Call g_clsAboutCalendar.GetCalendarTable1(lngY, lngM, tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：GP_GetCalendarTable1R '* 機能 ：カレンダーテーブル作成(当月1ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月23日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月23日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：カレンダー関連関数クラスが初期化済であること(本処理内では判定しない) '*************************************************************************************************** Public Sub GP_GetCalendarTable1R(ByVal lngY As Long, _ ByVal lngM As Long, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- ' カレンダーテーブル作成(当月分) Call g_clsAboutCalendar.GetCalendarTable1(lngY, lngM, tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：GP_GetCalendarTable3 '* 機能 ：カレンダーテーブル作成(当月+前後の3ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '* Arg4 = カレンダーテーブル当月開始INDEX(Long) ※Ref参照(Option) '* Arg5 = カレンダーテーブル当月終了INDEX(Long) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Public Sub GP_GetCalendarTable3(ByVal lngYear As Long, _ ByVal lngMonth As Long, _ ByRef tblCalendar() As g_typAboutCalendar2, _ Optional ByRef lngCurrStartIx As Long = -1, _ Optional ByRef lngCurrEndIx As Long = -1) '----------------------------------------------------------------------------------------------- ' カレンダー関連関数クラス初期化 Call GP_InitAboutCalendar ' カレンダーテーブル作成(当月+前後の3ヶ月用) Call g_clsAboutCalendar.GetCalendarTable3(lngYear, _ lngMonth, _ tblCalendar, _ lngCurrStartIx, _ lngCurrEndIx) End Sub '*************************************************************************************************** '* 処理名 ：GP_GetCalendarTable3R '* 機能 ：カレンダーテーブル作成(当月+前後の3ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '* Arg4 = カレンダーテーブル当月開始INDEX(Long) ※Ref参照(Option) '* Arg5 = カレンダーテーブル当月終了INDEX(Long) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月23日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月23日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：カレンダー関連関数クラスが初期化済であること(本処理内では判定しない) '*************************************************************************************************** Public Sub GP_GetCalendarTable3R(ByVal lngYear As Long, _ ByVal lngMonth As Long, _ ByRef tblCalendar() As g_typAboutCalendar2, _ Optional ByRef lngCurrStartIx As Long = -1, _ Optional ByRef lngCurrEndIx As Long = -1) '----------------------------------------------------------------------------------------------- ' カレンダーテーブル作成(当月+前後の3ヶ月用) Call g_clsAboutCalendar.GetCalendarTable3(lngYear, _ lngMonth, _ tblCalendar, _ lngCurrStartIx, _ lngCurrEndIx) End Sub '*************************************************************************************************** '* 処理名 ：GP_SumEigyoNissu '* 機能 ：営業日数算出(土日祝日を除外) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 期間開始日(Date) '* Arg2 = 期間終了日(Date) '* Arg3 = 営業日数(Long) ※Ref参照 '* Arg4 = 歴日数(Long) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：開始日､終了日自体も営業日判断に適用される '*************************************************************************************************** Public Sub GP_SumEigyoNissu(ByVal dteDateF As Date, _ ByVal dteDateT As Date, _ ByRef lngCntEigyo As Long, _ Optional ByRef lngCntReki As Long = 0) '----------------------------------------------------------------------------------------------- ' カレンダー関連関数クラス初期化 Call GP_InitAboutCalendar ' 営業日数算出(土日祝日を除外) Call g_clsAboutCalendar.SumEigyoNissu(dteDateF, dteDateT, lngCntEigyo, lngCntReki) End Sub '*************************************************************************************************** '* 処理名 ：GP_SumEigyoBi '* 機能 ：営業日数経過後営業日算出(土日祝日を除外) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 起算日(Date) '* Arg2 = 経過日数(Long) ※±可能 '* Arg3 = 営業日数経過後営業日(Date) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明：経過日数は翌日(翌営業日)を｢1｣として算出される(前営業日は｢-1｣) '* 注意事項：経過日数がゼロの場合は起算日をそのまま返す(土日祝判断なし) '*************************************************************************************************** Public Sub GP_SumEigyoBi(ByVal dteDateF As Date, _ ByVal lngCntKeika As Long, _ ByRef dteDateT As Date) '----------------------------------------------------------------------------------------------- ' カレンダー関連関数クラス初期化 Call GP_InitAboutCalendar ' 営業日数経過後営業日算出(土日祝日を除外) Call g_clsAboutCalendar.SumEigyoBi(dteDateF, lngCntKeika, dteDateT) End Sub '----------------------------------------<< End of Source >>----------------------------------------
続いて、実際の処理を行なうクラス「clsAboutCalendar2DF」です。
前頁の「clsAboutCalendar2R」では最後の方に祝日パラメータを作成するための個々の祝日の記述がありましたが、 「clsAboutCalendar2DF」ではファイルから祝日パラメータを読み込むため、個々の祝日の記述はありません。 代わりにファイルから祝日パラメータ読み込む記述があり、HTTP経由か通常のファイルかで処理が分れています。
他のプロシージャはここでは省略していますが、基本的には「祝日パラメータシート方式」と同じ記述です。 関心がある方は両方のソースコードを比べてみて下さい。
先頭の方にある定数の「祝日パラメータファイルのパス(又はURL)」とコメント説明されているのが実際に読み込まれる祝日パラメータのファイル名です。
説明したいのは「祝日パラメータテーブルの作成(GP_MakeHoliParameter)」ですが、 実際にはクラスの先頭で宣言しているファイルパスの先頭が「HTTP」で始まるかどうかで処理を分けており、 HTTPで始まる場合は「MSXML2.XMLHTTP60」「ADODB.Stream」を使う処理、 そうでない場合は「FileSystemObject」でファイルを読み込む処理へと分岐させています。'*************************************************************************************************** ' カレンダー及び日付処理(祝日含む)関連関数クラス clsAboutCalendar2DF(Class) ' ' ※本クラスの操作は全てカレンダー関連モジュール(modAboutCalendar2DF)で行ないます ' 本モジュールは祝日パラメータテーブルを作成してその祝日情報を元にカレンダーテーブルを作成します ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照設定] ' ・Microsoft Scripting Runtime ' ・Microsoft XML, v6.0 ' ・Microsoft ActiveX Data Objects 2.x Library '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '18/02/07(1.00)新規作成 '18/02/08(1.10)カレンダーテーブルに振替区分(0=通常､1=振替休日を行なわない)を追加する対応 '18/02/08(1.10)｢カレンダーテーブル作成(当月+前後の3ヶ月用)｣を追加 '18/02/10(1.20)クラス化移行のため、本モジュールはユーザー定義のみとする '18/02/18(1.30)動作改善のため再作成(クラス化は廃止) '18/02/21(1.40)GetCalendarTable3に当月開始・終了INDEXを返す引数(Option)を追加 '18/02/21(1.40)名称変更(g_typCalendar2⇒g_typAboutCalendar2) ※他との重複対応 '18/02/28(1.50)会社休日適用時に会社休日が振替休日や国民の休日と重なる時は法制休日を優先させる対応 '18/03/07(1.51)1日が日曜日だと週数が2始まりになってしまう件を修正 '18/03/07(1.60)各関数にチェック処理をスキップするオプションを追加(事前チェックが済んでいる前提です) '18/09/17(1.70)｢週数｣のカウント誤りを再修正 '18/09/17(1.70)祝日パラメータシートを使わない方式としてクラス化(チェック処理廃止⇒Subプロシージャ化) '18/09/23(1.71)クラス初期化判定を行なわないプロシージャを追加(連続呼び出し用、クラス側変更無し) '18/10/15(1.71)コード、コメント整理(バージョン値更新無し) '18/10/23(1.72)祝日パラメータテーブル要素追加の引数INDEXを廃止する対応(内部Static変数に変更) '18/12/08(1.73)新天皇即位の日(5/1)、即位礼正殿の儀(10/22)を2019年限定で追加(名称は暫定) '18/12/18(1.80)祝日パラメータをファイルから読み込む方式として新規作成 '19/12/22(1.81)春分の日・秋分の日算出の処理タイトルコメントの引数説明誤りを修正(処理変更無し) '21/10/08(1.82)祝日パラメータファイルのURLを暗号化(https)に変更 '*************************************************************************************************** Option Explicit '=================================================================================================== ' ↓↓↓ バージョン値、バージョン更新日は本クラスの変更を行なう時に必ず更新すること ↓↓↓ Private Const g_cnsCalendarVersion As String = "1.82" ' 本クラスのバージョン Private Const g_cnsCalendarVerUpdDate As Date = #10/8/2021# ' バージョン更新日 ' ↑↑↑ バージョン値、バージョン更新日は本クラスの変更を行なう時に必ず更新すること ↑↑↑ ' 祝日パラメータファイルのパス(又はURL) Private Const g_cnsSyukuParaPath As String = _ "https://www.asahi-net.or.jp/~ef2o-inue/ExcelDeOshigotoHoliday.txt" 'Private Const g_cnsSyukuParaPath As String = "D:\Web\ExcelDeOshigotoHoliday.txt" '=================================================================================================== Private Const g_cnsFuri As String = "(振替休日)" Private Const g_cnsKyu2 As String = "国民の休日" Private Const g_cnsKyu3 As String = "(会社休日)" '--------------------------------------------------------------------------------------------------- ' 祝日パラメータテーブル用ユーザー定義 Private Type g_typParamater Getsu As Long ' 月 SyoriKbn As Long ' 処理区分(0=固定日､1=HappyMonday､2=会社休日､9=特殊) Hiduke As Long ' [固定日]日(Date型ではない) FurikaeKbn As Long ' [固定日]振替区分(0=通常､1=振替休日を行なわない) HmSyusu As Long ' [HM]週数(第n週) HmYobi As Long ' [HM]曜日(0=日､1=月､2=火～6=土) SyukuNm As String ' 祝日名 StrYear As Long ' 開始年(西暦) EndYear As Long ' 終了年(西暦) End Type '--------------------------------------------------------------------------------------------------- ' 祝日パラメータ月別配置テーブル用ユーザー定義 Private Type g_typParamMMPos StrIx As Long ' 当月開始位置INDEX(祝日無しは-1) EndIx As Long ' 当月終了位置INDEX(祝日無しは-1) End Type '--------------------------------------------------------------------------------------------------- ' 振替休日・国民の休日判定対象テーブル用ユーザー定義 Private Type g_typFuriDIx CalIx As Long ' カレンダーINDEX Syubetsu As Long ' 0=振替休日、1=国民の休日 End Type '=================================================================================================== ' 祝日パラメータテーブル(全件) Private g_tblParamater() As g_typParamater ' 祝日パラメータテーブル '--------------------------------------------------------------------------------------------------- ' 祝日パラメータ配置テーブル(このテーブルは月をINDEXとするため1オリジン) Private g_tblParamMMPos(1 To 12) As g_typParamMMPos ' 祝日パラメータ月別配置テーブル '*************************************************************************************************** ' ■■■ プロパティ(Friend) ■■■ '*************************************************************************************************** ' 本クラスのバージョン(String) '--------------------------------------------------------------------------------------------------- Friend Property Get Version() As String Version = g_cnsCalendarVersion End Property '=================================================================================================== ' バージョン更新日(Date) '--------------------------------------------------------------------------------------------------- Friend Property Get VerUpdDate() As Date VerUpdDate = g_cnsCalendarVerUpdDate End Property '*************************************************************************************************** ' ■■■ 公開プロシージャ(Friend) ■■■ '*************************************************************************************************** '* 処理名 ：GetCalendarTable1 '* 機能 ：カレンダーテーブル作成(当月1ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Friend Sub GetCalendarTable1(ByVal lngY As Long, _ ByVal lngM As Long, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- ReDim tblCalendar(0) ' カレンダーテーブル作成(当月分) Call GP_GetCalendarSub(lngY, lngM, -1, tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：GetCalendarTable3 '* 機能 ：カレンダーテーブル作成(当月+前後の3ヶ月用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル(Array:Structure) ※Ref参照 '* Arg4 = カレンダーテーブル当月開始INDEX(Long) ※Ref参照(Option) '* Arg5 = カレンダーテーブル当月終了INDEX(Long) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月08日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Friend Sub GetCalendarTable3(ByVal lngYear As Long, _ ByVal lngMonth As Long, _ ByRef tblCalendar() As g_typAboutCalendar2, _ Optional ByRef lngCurrStartIx As Long = -1, _ Optional ByRef lngCurrEndIx As Long = -1) '----------------------------------------------------------------------------------------------- Dim lngCalIxMax As Long ' カレンダーテーブル要素上限 Dim lngY As Long ' 年WORK Dim lngM As Long ' 月WORK ReDim tblCalendar(0) lngCalIxMax = -1 ' 前月の年月を算出 If lngMonth = 1 Then lngY = lngYear - 1 lngM = 12 Else lngY = lngYear lngM = lngMonth - 1 End If ' カレンダーテーブル作成(前月分) Call GP_GetCalendarSub(lngY, lngM, lngCalIxMax, tblCalendar) '----------------------------------------------------------------------------------------------- ' 当月開始INDEX lngCurrStartIx = lngCalIxMax + 1 '----------------------------------------------------------------------------------------------- ' カレンダーテーブル作成(当月分) Call GP_GetCalendarSub(lngYear, lngMonth, lngCalIxMax, tblCalendar) '----------------------------------------------------------------------------------------------- ' 当月終了INDEX lngCurrEndIx = lngCalIxMax '----------------------------------------------------------------------------------------------- ' 翌月の年月を算出 If lngMonth = 12 Then lngY = lngYear + 1 lngM = 1 Else lngY = lngYear lngM = lngMonth + 1 End If ' カレンダーテーブル作成(翌月分) Call GP_GetCalendarSub(lngY, lngM, lngCalIxMax, tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：SumEigyoNissu '* 機能 ：営業日数算出(土日祝日を除外) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 期間開始日(Date) '* Arg2 = 期間終了日(Date) '* Arg3 = 営業日数(Long) ※Ref参照 '* Arg4 = 歴日数(Long) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月08日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：開始日､終了日自体も営業日判断に適用される '*************************************************************************************************** Friend Sub SumEigyoNissu(ByVal dteDateF As Date, _ ByVal dteDateT As Date, _ ByRef lngCntEigyo As Long, _ Optional ByRef lngCntReki As Long = 0) '----------------------------------------------------------------------------------------------- lngCntEigyo = 0 lngCntReki = 0 ' 時刻の除去 dteDateF = DateSerial(Year(dteDateF), Month(dteDateF), Day(dteDateF)) dteDateT = DateSerial(Year(dteDateT), Month(dteDateT), Day(dteDateT)) ' 開始日>終了日(逆転)の場合は処理なし If dteDateF > dteDateF Then Exit Sub '----------------------------------------------------------------------------------------------- Dim dteTmp As Date ' 作業日 Dim currY As Long ' 現在年 Dim currM As Long ' 現在月 Dim prevY As Long ' 直前年 Dim prevM As Long ' 直前月 Dim swSyuku As Boolean ' 祝日判定 Dim lngIxS As Long ' カレンダーテーブルINDEX Dim lngIxSMax As Long ' カレンダーテーブルINDEX上限 Dim tblCalendar() As g_typAboutCalendar2 ' カレンダーテーブル dteTmp = dteDateF currY = Year(dteTmp) currM = Month(dteTmp) '=============================================================================================== ' 終了日までループ Do While dteTmp <= dteDateT '------------------------------------------------------------------------------------------- ' ■月あたり前処理 lngIxS = 0 prevY = currY prevM = currM lngIxSMax = -1 ReDim tblCalendar(0) ' カレンダーテーブル作成(当月1ヶ月用) Call GP_GetCalendarSub(prevY, prevM, lngIxSMax, tblCalendar) '------------------------------------------------------------------------------------------- ' ■月あたり主処理(月替わりか終了日までループ) Do While ((dteTmp <= dteDateT) And (currY = prevY) And (currM = prevM)) '---------------------------------------------- ' 1日単位処理 swSyuku = False lngCntReki = lngCntReki + 1 ' 歴日数を加算 '---------------------------------------------- ' カレンダーテーブルをサーチ Do While lngIxS <= lngIxSMax ' 日付発見か If tblCalendar(lngIxS).Hiduke = dteTmp Then ' 祝日か判定 swSyuku = tblCalendar(lngIxS).Syuku <> 0 Exit Do End If ' 次へ lngIxS = lngIxS + 1 Loop '---------------------------------------------- ' 土日祝日でなければ営業日数を加算 If ((Weekday(dteTmp) <> vbSunday) And _ (Weekday(dteTmp) <> vbSaturday) And _ (Not swSyuku)) Then lngCntEigyo = lngCntEigyo + 1 ' 営業日数を加算 End If '---------------------------------------------- ' 翌日を設定 dteTmp = dteTmp + 1 currY = Year(dteTmp) currM = Month(dteTmp) Loop Loop End Sub '*************************************************************************************************** '* 処理名 ：SumEigyoBi '* 機能 ：営業日数経過後営業日算出(土日祝日を除外) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 起算日(Date) '* Arg2 = 経過日数(Long) ※±可能 '* Arg3 = 営業日数経過後営業日(Date) ※Ref参照(Option) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月08日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明：経過日数は翌日(翌営業日)を｢1｣として算出される(前営業日は｢-1｣) '* 注意事項：経過日数がゼロの場合は起算日をそのまま返す(土日祝判断なし) '*************************************************************************************************** Friend Sub SumEigyoBi(ByVal dteDateF As Date, _ ByVal lngCntKeika As Long, _ ByRef dteDateT As Date) '----------------------------------------------------------------------------------------------- dteDateT = dteDateF ' 一旦、起算日とする ' 経過日数がゼロなら非処理 ⇒ 起算日をそのまま返す(正常処理) If lngCntKeika = 0 Then Exit Sub '----------------------------------------------------------------------------------------------- Dim lngSign As Long ' ループ時の加算日数 Dim lngCntKeikaABS As Long ' 経過日数の絶対値 Dim dteTmp As Date ' 作業日 Dim currY As Long ' 現在年 Dim currM As Long ' 現在月 Dim prevY As Long ' 直前年 Dim prevM As Long ' 直前月 Dim lngCntEigyo As Long ' 営業日数 Dim swSyuku As Boolean ' 祝日判定 Dim lngIxS As Long ' カレンダーテーブルINDEX Dim lngIxSMax As Long ' カレンダーテーブルINDEX上限 Dim tblCalendar() As g_typAboutCalendar2 ' カレンダーテーブル dteTmp = dteDateF ' 経過日数の絶対値及び符号判定 If lngCntKeika > 0 Then ' プラスは後方に向かって判定 lngSign = 1 ' 翌日から判定を始める(起算日は0なので含めない) dteTmp = dteTmp + 1 Else ' マイナスは前方に向かって判定 lngSign = -1 ' 前日から判定を始める(起算日は0なので含めない) dteTmp = dteTmp - 1 End If lngCntKeikaABS = lngCntKeika * lngSign currY = Year(dteTmp) currM = Month(dteTmp) '=============================================================================================== ' 経過日数が経過するまでループ Do While lngCntEigyo < lngCntKeikaABS '------------------------------------------------------------------------------------------- ' ■月あたり前処理 prevY = currY prevM = currM lngIxSMax = -1 ReDim tblCalendar(0) ' カレンダーテーブル作成(当月1ヶ月用) Call GP_GetCalendarSub(prevY, prevM, lngIxSMax, tblCalendar) ' 経過日数がプラスか If lngCntKeika > 0 Then lngIxS = 0 '--------------------------------------------------------------------------------------- ' ■月あたり主処理(月替わりか終了日までループ) ※プラス時 Do While ((lngCntEigyo < lngCntKeikaABS) And (currY = prevY) And (currM = prevM)) '---------------------------------------------- ' 1日単位処理 swSyuku = False '---------------------------------------------- 'カレンダーテーブルをサーチ Do While lngIxS <= lngIxSMax ' 日付発見か If tblCalendar(lngIxS).Hiduke = dteTmp Then ' 祝日か判定 swSyuku = tblCalendar(lngIxS).Syuku <> 0 Exit Do End If ' 次へ lngIxS = lngIxS + 1 Loop '---------------------------------------------- ' 土日祝日でなければ営業日数を加算 If ((Weekday(dteTmp) <> vbSunday) And _ (Weekday(dteTmp) <> vbSaturday) And _ (Not swSyuku)) Then lngCntEigyo = lngCntEigyo + 1 ' 営業日数を加算 dteDateT = dteTmp ' 現在日をセット End If '---------------------------------------------- ' 翌日を設定 dteTmp = dteTmp + 1 currY = Year(dteTmp) currM = Month(dteTmp) Loop Else lngIxS = lngIxSMax '--------------------------------------------------------------------------------------- ' ■月あたり主処理(月替わりか終了日までループ) ※マイナス時 Do While ((lngCntEigyo < lngCntKeikaABS) And (currY = prevY) And (currM = prevM)) '---------------------------------------------- ' 1日単位処理 swSyuku = False '---------------------------------------------- 'カレンダーテーブルをサーチ(後ろから) Do While lngIxS >= 0 ' 日付発見か If tblCalendar(lngIxS).Hiduke = dteTmp Then ' 祝日か判定 swSyuku = tblCalendar(lngIxS).Syuku <> 0 Exit Do End If ' 次へ lngIxS = lngIxS - 1 Loop '---------------------------------------------- ' 土日祝日でなければ営業日数を加算 If ((Weekday(dteTmp) <> vbSunday) And _ (Weekday(dteTmp) <> vbSaturday) And _ (Not swSyuku)) Then lngCntEigyo = lngCntEigyo + 1 ' 営業日数を加算 dteDateT = dteTmp ' 現在日をセット End If '---------------------------------------------- ' 前日を設定 dteTmp = dteTmp - 1 currY = Year(dteTmp) currM = Month(dteTmp) Loop End If Loop End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：Class_Initialize '* 機能 ：クラス初期化(既定プロシージャ) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明：祝日パラメータテーブルの作成を行なう '* 注意事項： '*************************************************************************************************** Private Sub Class_Initialize() '----------------------------------------------------------------------------------------------- ' 祝日パラメータテーブルの作成 Call GP_MakeHoliParameter End Sub '*************************************************************************************************** '* 処理名 ：GP_GetCalendarSub '* 機能 ：カレンダーテーブル作成(単月分) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル要素上限(Long) ※Ref参照 '* Arg4 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年09月17日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：本処理ではカレンダーテーブルの初期化は行なわずに要素が追加される '*************************************************************************************************** Private Sub GP_GetCalendarSub(ByVal lngY As Long, _ ByVal lngM As Long, _ ByRef lngCalIxMax As Long, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngCalStrIx As Long ' 当月開始位置INDEX '----------------------------------------------------------------------------------------------- lngCalStrIx = lngCalIxMax + 1 ' カレンダーテーブル作成(当月分：追加モード) Call GP_MakeCalendarTable(lngY, lngM, lngCalIxMax, tblCalendar) '----------------------------------------------------------------------------------------------- ' 当月に祝日がない時は終了 If g_tblParamMMPos(lngM).EndIx < 0 Then Exit Sub '----------------------------------------------------------------------------------------------- Dim lngFuriDIxMax As Long ' 振替休日判定日INDEXテーブル上限 Dim tblFuriDIx() As g_typFuriDIx ' 振替休日判定日INDEXテーブル lngFuriDIxMax = -1 ReDim tblFuriDIx(0) ' カレンダーテーブルに祝日情報を更新(この時点では振替休日の処置はしない) Call GP_UpdateHolidayToCalendar(lngY, _ lngM, _ lngCalStrIx, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) '----------------------------------------------------------------------------------------------- ' 振替休日判定が必要か If lngFuriDIxMax >= 0 Then ' 振替休日・国民の休日設定 Call GP_UpdateFuriKokuminKyu(tblFuriDIx, tblCalendar) End If End Sub '*************************************************************************************************** '* 処理名 ：GP_MakeCalendarTable '* 機能 ：カレンダーテーブル作成(当月分：追加モード) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル要素上限(Long) ※Ref参照 '* Arg4 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年03月07日 '* 更新者 ：井上 治 '* 機能説明：カレンダーテーブルの日付要素の追加を行なう '* 注意事項：本処理ではカレンダーテーブルの初期化は行なわずに要素が追加される '*************************************************************************************************** Private Sub GP_MakeCalendarTable(ByVal lngY As Long, _ ByVal lngM As Long, _ ByRef lngCalIxMax As Long, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim dteStrDate As Date ' 月初日 Dim dteEndDate As Date ' 月末日 Dim dteDate As Date ' 作業日付 Dim lngSyusu As Long ' 週数(1始まり､日曜日発見で1加算) Dim lngHmSyusu As Long ' HM週数(0始まり､月曜日発見で1加算) Dim lngCalIxMax2 As Long ' dteStrDate = DateSerial(lngY, lngM, 1) dteEndDate = DateSerial(lngY, lngM + 1, 0) ' カレンダーテーブルの要素を追加(当月の日数分) lngCalIxMax2 = lngCalIxMax + Day(dteEndDate) ReDim Preserve tblCalendar(lngCalIxMax2) dteDate = dteStrDate ' 1日が日曜日の時に週数が2にならないように対応 If Weekday(dteStrDate, vbSunday) = vbSunday Then lngSyusu = 0 Else lngSyusu = 1 End If ' 月初日から月末日まで繰り返す Do While dteDate <= dteEndDate lngCalIxMax = lngCalIxMax + 1 With tblCalendar(lngCalIxMax) .Hiduke = dteDate .Yobi = Weekday(dteDate, vbSunday) - 1 ' ←日曜日=0とする値(VBAのWeekdayは1になる) ' 日曜日なら週数を加算 If .Yobi = 0 Then lngSyusu = lngSyusu + 1 ' 月曜日ならHM週数を加算 If .Yobi = 1 Then lngHmSyusu = lngHmSyusu + 1 .Syusu = lngSyusu .HmSyusu = lngHmSyusu End With ' 次の日へ dteDate = dteDate + 1 Loop End Sub '*************************************************************************************************** '* 処理名 ：GP_UpdateHolidayToCalendar '* 機能 ：カレンダーテーブルに祝日情報を更新 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = 月(Long) '* Arg3 = カレンダーテーブル当月開始位置INDEX(Long) '* Arg4 = 振替休日判定日INDEXテーブル上限INDEX(Long) ※Ref参照 '* Arg5 = 振替休日判定日INDEXテーブル(Array:Structure) ※Ref参照 '* Arg6 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年02月21日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：この時点では振替休日の処置はしない '*************************************************************************************************** Private Sub GP_UpdateHolidayToCalendar(ByVal lngY As Long, _ ByVal lngM As Long, _ ByVal lngCalStrIx As Long, _ ByRef lngFuriDIxMax As Long, _ ByRef tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngIxS_Str As Long ' 祝日テーブル当月開始位置 Dim lngIxS_End As Long ' 祝日テーブル当月終了位置 Dim lngIxSyuku As Long ' 祝日テーブルテーブルINDEX ' 祝日パラメータテーブルの当月範囲を得る lngIxS_Str = g_tblParamMMPos(lngM).StrIx lngIxS_End = g_tblParamMMPos(lngM).EndIx ' カレンダーテーブルに祝日情報を更新(この時点では振替休日の判断はしない) For lngIxSyuku = lngIxS_Str To lngIxS_End With g_tblParamater(lngIxSyuku) ' 祝日パラメータの有効年範囲を判定 If ((.StrYear <= lngY) And (.EndYear >= lngY)) Then ' 処理区分の判定 Select Case .SyoriKbn Case 0 ' 固定日 ' 祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) Call GP_UpdateHolidaySUB1(.Hiduke, _ .SyukuNm, _ 1, _ .FurikaeKbn, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) Case 1 ' HappyMonday ' 祝日情報のカレンダーテーブル更新(サブ処理：週数＋曜日で判定) Call GP_UpdateHolidaySUB2(.HmSyusu, _ .HmYobi, _ .SyukuNm, _ 1, _ .FurikaeKbn, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) Case 2 ' 固定日(会社休日) ' 祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) Call GP_UpdateHolidaySUB1(.Hiduke, _ .SyukuNm, _ 3, _ .FurikaeKbn, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) Case 9 ' 特殊処理 ' 3月か If lngM = 3 Then ' 春分の日の算出(簡易計算方式) Call GP_GetSyunbun(lngY, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) ElseIf lngM = 9 Then ' 秋分の日の算出(簡易計算方式) Call GP_GetSyuubun(lngY, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) Else ' 他月は無視 End If End Select End If End With Next lngIxSyuku End Sub '*************************************************************************************************** '* 処理名 ：GP_UpdateHolidaySUB1 '* 機能 ：祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 日(Long:1～31) '* Arg2 = 祝日名称(String) '* Arg3 = 祝日判定(Long:0=通常､1=祝日､2=振替休日､3=会社休日) '* Arg4 = 振替区分(Long:0=通常､1=振替休日を行なわない) '* Arg5 = カレンダー当月開始位置INDEX(Long) '* Arg6 = 祝日パラメータテーブルINDEX(Long) '* Arg7 = 振替休日判定日INDEXテーブルINDEX(Long) ※Ref参照 '* Arg8 = 振替休日判定日INDEXテーブル(Array:Structure) ※Ref参照 '* Arg9 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年02月28日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_UpdateHolidaySUB1(ByVal lngDay As Long, _ ByVal strName As String, _ ByVal lngSyuku As Long, _ ByVal lngFurikaeKbn As Long, _ ByVal lngCalStrIx As Long, _ ByVal lngIxSyuku As Long, _ ByRef lngFuriDIxMax As Long, _ ByRef tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngIx As Long ' テーブルINDEX Dim lngIxMax As Long ' テーブルINDEX上限 Dim lngIxA1 As Long ' テーブルINDEX(1日後) Dim lngIxA2 As Long ' テーブルINDEX(2日後) Dim lngIxB1 As Long ' テーブルINDEX(1日前) Dim lngIxB2 As Long ' テーブルINDEX(2日前) Dim lngIxSD As Long ' 振替休日判定日INDEXテーブルINDEX Dim lngIxSyukuN As Long ' 次の祝日パラメータテーブルINDEX Dim lngYearN As Long ' 次の年 Dim lngMonthN As Long ' 次の月 ' ｢日｣から該当するカレンダーテーブル上のINDEXを算出 lngIx = lngCalStrIx + lngDay - 1 lngIxMax = UBound(tblCalendar) '------------------------------------------------------- ' 当該日が既に祝日(又は振替休日、国民の休日)だったら｢会社休日｣は適用しない ' ※この判定には｢会社休日｣の対する振替区分の判断は行なっていません If ((lngSyuku = 3) And (tblCalendar(lngIx).Syuku <> 0)) Then Exit Sub End If '------------------------------------------------------- ' 前後の日付位置INDEXを算出 lngIxA1 = lngIx + 1 lngIxA2 = lngIx + 2 lngIxB1 = lngIx - 1 lngIxB2 = lngIx - 2 ' 祝日情報を反映 With tblCalendar(lngIx) .Syuku = lngSyuku .SyukuNm = strName .FurikaeKbn = lngFurikaeKbn End With ' 振替休日を行なわない時は終了 If lngFurikaeKbn = 1 Then Exit Sub '----------------------------------------------------------------------------------------------- ' 日曜日又は前後判定で｢国民の休日｣対象なら振替休日判定日INDEXテーブルに追加 If tblCalendar(lngIx).Yobi = 0 Then lngFuriDIxMax = lngFuriDIxMax + 1 ReDim Preserve tblFuriDIx(lngFuriDIxMax) tblFuriDIx(lngFuriDIxMax).CalIx = lngIx tblFuriDIx(lngFuriDIxMax).Syubetsu = 0 Exit Sub End If ' 2日前が祝日で1日前が祝日でない⇒｢国民の休日｣対象 If lngIxB2 >= 0 Then If ((tblCalendar(lngIxB2).Syuku <> 0) And _ (tblCalendar(lngIxB1).Syuku = 0) And _ (tblCalendar(lngIxB2).FurikaeKbn = 0)) Then lngFuriDIxMax = lngFuriDIxMax + 1 ReDim Preserve tblFuriDIx(lngFuriDIxMax) tblFuriDIx(lngFuriDIxMax).CalIx = lngIxB2 tblFuriDIx(lngFuriDIxMax).Syubetsu = 1 Exit Sub End If End If ' 2日後が祝日で1日後が祝日でない⇒｢国民の休日｣対象 If lngIxA2 <= lngIxMax Then If ((tblCalendar(lngIxA2).Syuku <> 0) And _ (tblCalendar(lngIxA1).Syuku = 0) And _ (tblCalendar(lngIxA2).FurikaeKbn = 0)) Then lngFuriDIxMax = lngFuriDIxMax + 1 ReDim Preserve tblFuriDIx(lngFuriDIxMax) tblFuriDIx(lngFuriDIxMax).CalIx = lngIx tblFuriDIx(lngFuriDIxMax).Syubetsu = 1 Exit Sub End If End If ' 月末日の1日前⇒翌月1日が祝日か判定 If lngIx = lngIxMax - 1 Then ' 次の祝日パラメータテーブルINDEX lngIxSyukuN = lngIxSyuku + 1 ' 次の祝日が1日か If ((g_tblParamater(lngIxSyukuN).Hiduke = 1) And _ (g_tblParamater(lngIxSyukuN).FurikaeKbn = 0)) Then lngYearN = Year(tblCalendar(lngIx).Hiduke) lngMonthN = Month(tblCalendar(lngIx).Hiduke) + 1 ' 次の月 ' 次の月が有効か If lngMonthN > 12 Then lngYearN = lngYearN + 1 lngMonthN = 1 End If With g_tblParamater(lngIxSyukuN) ' 有効な祝日か If ((.Getsu = lngMonthN) And _ (.StrYear <= lngYearN) And _ (.EndYear >= lngYearN)) Then ' 月末日が｢国民の休日｣対象 lngFuriDIxMax = lngFuriDIxMax + 1 ReDim Preserve tblFuriDIx(lngFuriDIxMax) tblFuriDIx(lngFuriDIxMax).CalIx = lngIx tblFuriDIx(lngFuriDIxMax).Syubetsu = 1 Exit Sub End If End With End If End If End Sub '*************************************************************************************************** '* 処理名 ：GP_UpdateHolidaySUB2 '* 機能 ：祝日情報のカレンダーテーブル更新(サブ処理：週数＋曜日で判定) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = HM週数(Long) '* Arg2 = 曜日(Long) '* Arg3 = 祝日名称(String) '* Arg4 = 祝日判定(0=通常､1=祝日､2=振替休日､3=会社休日) '* Arg5 = 振替区分(0=通常､1=振替休日を行なわない) '* Arg6 = カレンダー当月開始位置INDEX(Long) '* Arg7 = 祝日パラメータテーブルINDEX(Long) '* Arg8 = 振替休日判定日INDEXテーブルINDEX(Long) ※Ref参照 '* Arg9 = 振替休日判定日INDEXテーブル(Array:Structure) ※Ref参照 '* Arg10= カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年02月21日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_UpdateHolidaySUB2(ByVal lngSyusu As Long, _ ByVal lngYobi As Long, _ ByVal strName As String, _ ByVal lngHoli As Long, _ ByVal lngFurikaeKbn As Long, _ ByVal lngCalStrIx As Long, _ ByVal lngIxSyuku As Long, _ ByRef lngFuriDIxMax As Long, _ ByRef tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngIx As Long ' テーブルINDEX lngIx = lngCalStrIx ' カレンダーテーブルから該当週数＋曜日を探す Do While lngIx <= UBound(tblCalendar) ' HM週数＋曜日発見か If ((tblCalendar(lngIx).HmSyusu = lngSyusu) And (tblCalendar(lngIx).Yobi = lngYobi)) Then ' 祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) Call GP_UpdateHolidaySUB1(Day(tblCalendar(lngIx).Hiduke), _ strName, _ lngHoli, _ lngFurikaeKbn, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) Exit Do End If ' 次へ lngIx = lngIx + 1 Loop End Sub '*************************************************************************************************** '* 処理名 ：GP_GetSyunbun '* 機能 ：春分の日の算出(簡易計算方式) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = カレンダー当月開始位置INDEX(Long) '* Arg3 = 祝日パラメータテーブルINDEX(Long) '* Arg4 = 振替休日判定日INDEXテーブルINDEX上限(Long) ※Ref参照 '* Arg5 = 振替休日判定日INDEXテーブル(Array:Structure) ※Ref参照 '* Arg6 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明：本計算方法は1948～2150年まで算出可能 '* 注意事項：本処理内では振替休日判定は行なわない '*************************************************************************************************** Private Sub GP_GetSyunbun(ByVal lngY As Long, _ ByVal lngCalStrIx As Long, _ ByVal lngIxSyuku As Long, _ ByRef lngFuriDIxMax As Long, _ ByRef tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngD As Long ' 算出日 Dim lngY2 As Long ' 年算出WORK ' 祝日法施行(1947年)以前,2151年以降(簡易計算不可)は無視 lngY2 = lngY - 1980 Select Case lngY Case Is <= 1979 lngD = Int(20.8357 + (0.242194 * lngY2) - Int(lngY2 / 4)) Case Is <= 2099 lngD = Int(20.8431 + (0.242194 * lngY2) - Int(lngY2 / 4)) Case Else lngD = Int(21.851 + (0.242194 * lngY2) - Int(lngY2 / 4)) End Select ' 祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) Call GP_UpdateHolidaySUB1(lngD, _ "春分の日", _ 1, _ 0, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：GP_GetSyuubun '* 機能 ：秋分の日の算出(簡易計算方式) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 年(Long) '* Arg2 = カレンダー当月開始位置INDEX(Long) '* Arg3 = 祝日パラメータテーブルINDEX(Long) '* Arg4 = 振替休日判定日INDEXテーブルINDEX上限(Long) ※Ref参照 '* Arg5 = 振替休日判定日INDEXテーブル(Array:Structure) ※Ref参照 '* Arg6 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明：本計算方法は1948～2150年まで算出可能 '* 注意事項：本処理内では振替休日判定は行なわない '*************************************************************************************************** Private Sub GP_GetSyuubun(ByVal lngY As Long, _ ByVal lngCalStrIx As Long, _ ByVal lngIxSyuku As Long, _ ByRef lngFuriDIxMax As Long, _ ByRef tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngD As Long ' 算出日 Dim lngY2 As Long ' 年算出WORK ' 祝日法施行(1947年)以前,2151年以降(簡易計算不可)は無視 lngY2 = lngY - 1980 Select Case lngY Case Is <= 1979 lngD = Int(23.2588 + (0.242194 * lngY2) - Int(lngY2 / 4)) Case Is <= 2099 lngD = Int(23.2488 + (0.242194 * lngY2) - Int(lngY2 / 4)) Case Else lngD = Int(24.2488 + (0.242194 * lngY2) - Int(lngY2 / 4)) End Select ' 祝日情報のカレンダーテーブル更新(サブ処理：日付で判定) Call GP_UpdateHolidaySUB1(lngD, _ "秋分の日", _ 1, _ 0, _ lngCalStrIx, _ lngIxSyuku, _ lngFuriDIxMax, _ tblFuriDIx, _ tblCalendar) End Sub '*************************************************************************************************** '* 処理名 ：GP_UpdateFuriKokuminKyu '* 機能 ：振替休日・国民の休日設定 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 振替休日判定日INDEXテーブル(Array:Structure) '* Arg2 = カレンダーテーブル(Array:Structure) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年02月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年02月28日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_UpdateFuriKokuminKyu(tblFuriDIx() As g_typFuriDIx, _ ByRef tblCalendar() As g_typAboutCalendar2) '----------------------------------------------------------------------------------------------- Dim lngIxF As Long ' 振替休日判定日テーブルINDEX Dim lngIxC As Long ' カレンダーテーブルINDEX Dim lngIxFMax As Long ' 振替休日判定日テーブルINDEX上限 Dim lngIxCMax As Long ' カレンダーテーブルINDEX上限 lngIxFMax = UBound(tblFuriDIx) lngIxCMax = UBound(tblCalendar) '----------------------------------------------------------------------------------------------- Do While lngIxF <= lngIxFMax ' 翌日のカレンダー位置を算出 lngIxC = tblFuriDIx(lngIxF).CalIx + 1 ' 振替休日か If tblFuriDIx(lngIxF).Syubetsu = 0 Then ' 翌日以降の最初の平日(又は会社休日)を｢振替休日｣とする Do While lngIxC <= lngIxCMax ' 祝日以外(又は会社休日)を発見 If ((tblCalendar(lngIxC).Syuku = 0) Or (tblCalendar(lngIxC).Syuku = 3)) Then ' 振替休日とする(会社休日は振替休日に置き換える) tblCalendar(lngIxC).Syuku = 2 tblCalendar(lngIxC).SyukuNm = g_cnsFuri ' 振替休日 Exit Do ElseIf tblCalendar(lngIxC).SyukuNm = g_cnsKyu2 Then ' 既に国民の休日がある場合は処置中止(国民の休日のままにする) Exit Do End If ' 次の日へ lngIxC = lngIxC + 1 Loop Else ' 国民の休日 ' 翌日を｢国民の休日｣とする tblCalendar(lngIxC).Syuku = 1 tblCalendar(lngIxC).SyukuNm = g_cnsKyu2 ' 国民の休日 End If ' 次へ lngIxF = lngIxF + 1 Loop End Sub '*************************************************************************************************** '* 処理名 ：GP_MakeHoliParameter '* 機能 ：祝日パラメータテーブルの作成 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年12月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_MakeHoliParameter() '----------------------------------------------------------------------------------------------- Dim lngIxTbl As Long ' テーブルINDEX Dim blnRet As Boolean ' 処理成否 Dim strErrMSG As String ' エラーメッセージ ' 祝日パラ月別範囲テーブルを一旦初期化 For lngIxTbl = 1 To 12 With g_tblParamMMPos(lngIxTbl) .StrIx = -1 .EndIx = -1 End With Next lngIxTbl ReDim g_tblParamater(0) '----------------------------------------------------------------------------------------------- ' URLか If UCase(Left(g_cnsSyukuParaPath, 4)) = "HTTP" Then ' 祝日パラメータテーブルの作成(URLより) blnRet = FP_MakeHoliParameter1(strErrMSG) Else ' 祝日パラメータテーブルの作成(ファイルより) blnRet = FP_MakeHoliParameter2(strErrMSG) End If ' 失敗か If Not blnRet Then strErrMSG = strErrMSG & vbCrLf & vbCrLf & "※作成するカレンダーには祝日が反映されません。" MsgBox strErrMSG, vbCritical End If End Sub '*************************************************************************************************** '* 処理名 ：FP_MakeHoliParameter1 '* 機能 ：祝日パラメータテーブルの作成(URLより) '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = エラーメッセージ(String) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年12月18日 '* 作成者 ：井上 治 '* 更新日 ：2018年12月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_MakeHoliParameter1(ByRef strErrMSG As String) As Boolean '----------------------------------------------------------------------------------------------- Const cnsCharSet As String = "Shift-JIS" Dim objHttp As MSXML2.XMLHTTP60 ' MSXML2.XMLHTTP Dim objStream As ADODB.Stream ' ADODB.Stream Dim lngIx As Long ' テーブルINDEX Dim strRet As String ' 受け取り文字列 Dim vntRet As Variant ' 受け取り値 FP_MakeHoliParameter1 = False On Error GoTo MakeHoliParameter1_ERROR ' URLから読み込み Set objHttp = New MSXML2.XMLHTTP60 ' 同期通信を設定 objHttp.Open "GET", g_cnsSyukuParaPath, False ' 要求を送信 objHttp.send vbNull ' 読み込み待ち Do While objHttp.Status < 4 DoEvents Loop ' Streamに読み込む Set objStream = New ADODB.Stream With objStream .Open .Position = 0 .Type = adTypeBinary .Write objHttp.responseBody .Position = 0 .Type = adTypeText .Charset = cnsCharSet strRet = .ReadText .Close End With Set objStream = Nothing Set objHttp = Nothing ' 改行(LFのみ)で分解 vntRet = Split(strRet, vbLf) lngIx = 0 ' 全件繰り返す Do While lngIx <= UBound(vntRet) ' 祝日パラメータテーブル要素追加 Call GP_ApendHoliParam(Trim(vntRet(lngIx))) ' 次へ lngIx = lngIx + 1 Loop FP_MakeHoliParameter1 = True On Error GoTo 0 Exit Function '=================================================================================================== MakeHoliParameter1_ERROR: strErrMSG = Err.Description On Error GoTo 0 End Function '*************************************************************************************************** '* 処理名 ：FP_MakeHoliParameter2 '* 機能 ：祝日パラメータテーブルの作成(ファイルより) '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = エラーメッセージ(String) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年12月18日 '* 作成者 ：井上 治 '* 更新日 ：2018年12月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_MakeHoliParameter2(ByRef strErrMSG As String) As Boolean '----------------------------------------------------------------------------------------------- Dim objFso As FileSystemObject ' FileSystemObject Dim objTs As TextStream ' TextStream FP_MakeHoliParameter2 = False On Error GoTo MakeHoliParameter2_ERROR ' 祝日パラメータファイルの読み込み Set objFso = New FileSystemObject Set objTs = objFso.OpenTextFile(g_cnsSyukuParaPath, ForReading, False, TristateFalse) ' 最終行まで繰り返す Do Until objTs.AtEndOfStream ' 祝日パラメータテーブル要素追加 Call GP_ApendHoliParam(Trim(objTs.ReadLine)) Loop objTs.Close Set objTs = Nothing Set objFso = Nothing FP_MakeHoliParameter2 = True On Error GoTo 0 Exit Function '=================================================================================================== MakeHoliParameter2_ERROR: strErrMSG = Err.Description On Error GoTo 0 End Function '*************************************************************************************************** '* 処理名 ：GP_ApendHoliParam '* 機能 ：祝日パラメータテーブル要素追加 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 祝日パラメータレコード(String) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2018年09月17日 '* 作成者 ：井上 治 '* 更新日 ：2018年12月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：テーブルINDEXは本処理側で加算されます '*************************************************************************************************** Private Sub GP_ApendHoliParam(ByVal strHoliPara As String) '----------------------------------------------------------------------------------------------- Static lngIxTbl As Long ' テーブルINDEX Dim lngGetsu As Long ' 月 ' ブランク(最終行)は除外 If strHoliPara = "" Then Exit Sub lngGetsu = CLng(Left(strHoliPara, 2)) ReDim Preserve g_tblParamater(lngIxTbl) ' 祝日パラ月別範囲テーブルを更新 With g_tblParamMMPos(lngGetsu) ' 開始位置 If .StrIx < 0 Then .StrIx = lngIxTbl .EndIx = lngIxTbl End With ' 祝日パラメータテーブル要素追加 With g_tblParamater(lngIxTbl) .Getsu = lngGetsu .SyoriKbn = CLng(Mid(strHoliPara, 3, 1)) .Hiduke = CLng(Mid(strHoliPara, 4, 2)) .FurikaeKbn = CLng(Mid(strHoliPara, 6, 1)) .HmSyusu = CLng(Mid(strHoliPara, 7, 1)) .HmYobi = CLng(Mid(strHoliPara, 8, 1)) .StrYear = CLng(Mid(strHoliPara, 9, 4)) .EndYear = CLng(Mid(strHoliPara, 13, 4)) .SyukuNm = Mid(strHoliPara, 17) End With ' テーブルINDEXを加算 lngIxTbl = lngIxTbl + 1 End Sub '----------------------------------------<< End of Source >>----------------------------------------
どちらも読み込んだ後は改行で分断される行ごとに「祝日パラメータテーブル要素追加(GP_ApendHoliParam)」を呼び出して、 行内を指定の桁ごとに分割させて祝日パラメータテーブルへ追加を行なっています。
ExcelワークブックであればWebサイト(HTTP)上のものであってもそのままExcelで開くことができますが、 テキストファイルの場合はFileSystemObjectではWebサイト(HTTP)上のものを扱うことができないので このような方法になっています。
（転用利用される場合は先頭コメントにある「参照設定」にご注意下さい）