カレンダー計算


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


■フォーム設計(F_DayCalc)
テキストボックス
	以下のテキストボックスを配置します。
指定月日........................... カレンダーの基準日となります。不可視とします。
年度...................................... [指定月日]から"年"を取り出します。
月度...................................... [指定月日]から"月"を取り出します。
HitCount............................ 日にちボタンがONの状態をカウント表示します。
トグルボタン
	日にちのトグルボタンを37個順番に作成します。
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」で動作を確認してみて下さい。

戻る