カレンダー計算

概要：
フォーム上に日にちにあたるトグルボタンを配置して日にちのカウント数を表示するプログラムです。
カレンダー処理の応用例としてご活用下さい。

■フォーム設計（F_DayCalc）

・テキストボックス

	以下のテキストボックスを配置します。

指定月日.........................	カレンダーの基準日となります。不可視とします。
年度.............................	[指定月日]から"年"を取り出します。
月度.............................	[指定月日]から"月"を取り出します。
HitCount.........................	日にちﾎﾞﾀﾝがＯＮの状態をカウント表示します。

・トグルボタン

	日にちのトグルボタンを３７個順番に作成します。

D1～D37............................

[更新後処理]ｲﾍﾞﾝﾄﾌﾟﾛｼ-ｼﾞｬではカウント数を表示するﾌﾟﾛｼｰｼﾞｬを実行します。

・コマンドボタン

CLR............................	[読み込み時]ｲﾍﾞﾝﾄﾌﾟﾛｼｰｼﾞｬを実行して初期状態に戻します。
YearUp..........................	年度をひとつ繰り上げます。
YearDown........................	年度をひとつ繰り下げます。
MonthUp.........................	月度をひとつ繰り上げます。
MonthDown.......................	月度をひとつ繰り下げます。

・フォームクラスモジュール

Private Sub CLR_Click()
　　'リセットします
　　Call Form_Load
End Sub

Private Sub Form_Load()
　　'カレンダーの日にちをセットします
　　Call CldSet([Forms]![F_DayCalc])
　　'カウント数を再計算します
　　Call HiCnt([Forms]![F_DayCalc])
End Sub

Private Sub MonthDown_Click()
　　'月度指定月日の月をひとつ繰り下げます
　　Me![指定月日] = DateAdd("m", -1, [指定月日])
　　'月度ﾃｷｽﾄﾎﾞｯｸｽを再計算します
　　Me!月度.Requery
　　'ｵﾌﾞｼﾞｪｸﾄの再描画
　　DoCmd.RepaintObject
　　'リセットします
　　Call Form_Load
End Sub

Private Sub MonthUp_Click()
　　'月度指定月日の月をひとつ繰り上げます
　　Me![指定月日] = DateAdd("m", 1, [指定月日])
　　'月度ﾃｷｽﾄﾎﾞｯｸｽを再計算します
　　Me!月度.Requery
　　'ｵﾌﾞｼﾞｪｸﾄの再描画
　　DoCmd.RepaintObject
　　'リセットします
　　Call Form_Load
End Sub

Private Sub YearDoen_Click()
　　'月度指定月日の年をひとつ繰り下げます
　　Me![指定月日] = DateAdd("yyyy", -1, [指定月日])
　　'年度ﾃｷｽﾄﾎﾞｯｸｽを再計算します
　　Me!年度.Requery
　　'ｵﾌﾞｼﾞｪｸﾄの再描画
　　DoCmd.RepaintObject
　　'リセットします
　　Call Form_Load
End Sub

Private Sub YearUp_Click()
　　'月度指定月日の年をひとつ繰り上げます
　　Me![指定月日] = DateAdd("yyyy", 1, [指定月日])
　　'年度ﾃｷｽﾄﾎﾞｯｸｽを再計算します
　　Me!年度.Requery
　　'ｵﾌﾞｼﾞｪｸﾄの再描画
　　DoCmd.RepaintObject
　　'リセットします
　　Call Form_Load
End Sub

■モジュール（モジュール1）

Public Function HiCnt(F As Form) As Integer
　　Dim i As Integer
　　'カウント数をクリアします
　　HiCnt = 0
　　'日付コントロールをカウントします。
　　For i = 0 To 36
　　　　'ﾄｸﾞﾙﾎﾞﾀﾝが押されていたら加えます
　　　　If F(i).Value Then
　　　　　　HiCnt = HiCnt + 1
　　　　End If
　　Next i
　　F!HitCount = HiCnt
End Function

Public Function CldSet(F As Form)
　　Dim StDAY As Date
　　Dim Youbi, i, DayCnt As Integer
　　'開始日を設定します。
　　StDAY = CVDate(F!年度 & "/" & F!月度 & "/01")
　　Youbi = WeekDay(StDAY) - 1
　　DayCnt = Day(DateSerial(Year(StDAY), Month(StDAY) + 1, 0))
　　'開始曜日までを不可視
　　For i = 0 To Youbi - 1
　　　　F(i).Visible = False
　　　　F(i).Value = False
　　Next i
　　'開始曜日から末日までを可視
　　For i = Youbi To DayCnt + Youbi - 1
　　　　F(i).Visible = True
　　　　F(i).Value = False
　　Next i
　　'末日から格納終了までを不可視
　　For i = DayCnt + Youbi To 36
　　　　F(i).Visible = False
　　　　F(i).Value = False
　　Next i
　　'日にちの標題を決めます
　　F(Youbi).Caption = 1
　　For i = 1 To DayCnt - 1
　　　　F(Youbi + i).Caption = i + 1
　　Next i
End Function

※ DownLoad の「daycalc.zip」で動作を確認してみて下さい。

戻る