Go to Qiita Advent Calendar 2024 Top
LoginSignup
2
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

@redoriva

Accessでカレンダーフォームを作る

Last updated at Posted at 2017-08-11

この記事はAccess2016を使用しております。

ActiveXコントロールの「Microsoft Date and Time Picker Control 6.0」を使えばシンプルでスッキリしたデザインのコントロールが使えます。

しかし、Windows10のアップデートにより表示が崩れたり、そもそも今後サポートされなくなったりするかもしれません。

そこで、同じような動きをするフォームを作ってみました。

完成図

テキストボックスをクリックするとカレンダーフォームが表示され、カレンダーフォームで日付を選択すると、テキストボックスの内容が変化すると言うフォームを作りました。
ちなみにAccess2000以降に対応しています。

image.png

フォームを作る

image.png

フォームの構成はラベルを除き次の通りです。

種類 名前 用途
コマンドボタン YearUpButton 一年増やす
コマンドボタン YearDownButton 一年減らす
コマンドボタン MonthUpButton 一月増やす
コマンドボタン MonthDownButton 一月減らす
オプショングループ Days 日の選択
トグルボタン DayTgl1_[1-6] 日曜日の週
トグルボタン DayTgl2_[1-6] 月曜日の週
トグルボタン DayTgl3_[1-6] 火曜日の週
トグルボタン DayTgl4_[1-6] 水曜日の週
トグルボタン DayTgl5_[1-6] 木曜日の週
トグルボタン DayTgl6_[1-6] 金曜日の週
トグルボタン DayTgl7_[1-6] 土曜日の週
テキストボックス NowTextBox 今日の日付を表示
テキストボックス YearTextbox 選択されている年を表示
テキストボックス MonthTextbox 選択されている月を表示
テキストボックス SelectedDateTextBox 選択されている日付を表示

トグルボタンのオプション値

日 月 火 水 木 金 土
11 21 31 41 51 61 71
12 22 32 42 52 62 72
13 23 33 43 53 63 73
14 24 34 44 54 64 74
15 25 35 45 55 65 75
16 26 36 46 56 66 76

コードの全容

CalenderForm.cls
Option Compare Database
Option Explicit

Public Selected_Date As Date
Public Form_Name As String
Public Date_Control_Name As String

' /// 2017/7/31 カレンダーフォームVer2

' /// Copyright (c) 2017 redoriva
' /// Released under the MIT license
' /// http://opensource.org/licenses/mit-license.php

' /// 使用上の注意
' /// このフォームを開く時 OpenArgs には"フォーム名,日付コントロール名"を代入して下さい。

' 日付を返す
Private Sub SetDate()
    Forms(Form_Name).Controls(Date_Control_Name).Value = Format(Selected_Date, "yyyy/mm/dd")
End Sub

' オプショングループに配置したトグルをクリックして更新した後の処理
Private Sub Days_AfterUpdate()
    Dim week_count As Integer
    Dim week_zone_count As Integer
    
    week_count = Left(CStr(Days), 1)
    week_zone_count = Right(CStr(Days), 1)
    
    Dim day_count As Integer
    
    day_count = Me("DayTgl" & week_count & "_" & week_zone_count).Caption
    
    Selected_Date = DateSerial(Me.YearTextbox.Value, Me.MonthTextbox.Value, day_count)
    
    If week_zone_count = 1 And day_count >= 8 Then
        '1週目で8以上の数値は先月扱いとする
        Selected_Date = DateAdd("M", -1, Selected_Date)
        Me.SelectedDateTextBox.Value = Selected_Date
        Me.YearTextbox.Value = Year(Selected_Date)
        Me.MonthTextbox.Value = Month(Selected_Date)
        Call CalenderCreate
    ElseIf week_zone_count >= 5 And day_count <= 15 Then
        '5週目移行で15以下の数値は来月扱いとする
        Selected_Date = DateAdd("M", 1, Selected_Date)
        Me.SelectedDateTextBox.Value = Selected_Date
        Me.YearTextbox.Value = Year(Selected_Date)
        Me.MonthTextbox.Value = Month(Selected_Date)
        Call CalenderCreate
    Else
        Me.SelectedDateTextBox.Value = Selected_Date
    End If
    
    Call SetDate
End Sub

' フォームを開いた時の処理
Private Sub Form_Open(Cancel As Integer)
    On Error GoTo err1

    Form_Name = Split(OpenArgs, ",")(0)
    Date_Control_Name = Split(OpenArgs, ",")(1)

    Me.NowTextBox.Value = Format(Now(), "今日:yyyy\年m\月d日(aaa)")
    
    If IsDate(Forms(Form_Name).Controls(Date_Control_Name).Value) = True Then
        Selected_Date = Forms(Form_Name).Controls(Date_Control_Name).Value
        Me.SelectedDateTextBox.Value = Format(Selected_Date, "選択日:yyyy\年m\月d日(aaa)")
        Me.YearTextbox.Value = Year(Selected_Date)
        Me.MonthTextbox.Value = Month(Selected_Date)
    Else
        Selected_Date = Now()
        Me.SelectedDateTextBox.Value = Format(Selected_Date, "選択日:yyyy\年m\月d日(aaa)")
        Me.YearTextbox.Value = Year(Now)
        Me.MonthTextbox.Value = Month(Now)
    End If
    
    Call CalenderCreate
    
    Call SetDate
Exit Sub
err1:
    MsgBox "OpenArgsが正しくセットされていない為、処理を中止します。" & vbNewLine & "Docmd.OpenFormのOpenArgsにはフォーム名,日付で使うコントロール名として下さい。", vbOKOnly + vbCritical, "処理中断"
    DoCmd.Close acForm, "CalenderForm"
End Sub

' トグルボタンの日付をセットする処理
Private Sub CalenderCreate()
    'まず1日が何曜日かセットする
    '1:日～7:土
    Dim first_day As Date
    Dim first_day_week As Integer
    Dim week_count As Integer
    Dim week_zone_count As Integer
    Dim date_count As Date
    
    first_day = DateSerial(Me.YearTextbox.Value, Me.MonthTextbox.Value, 1)
    first_day_week = Weekday(first_day, vbSunday)
    
    Me("DayTgl" & first_day_week & "_1").Caption = 1
    Me("DayTgl" & first_day_week & "_1").ForeColor = RGB(0, 0, 0)
    
    '1日以前の日付をセットする
    If first_day_week > 1 Then
        week_count = 0
        For week_count = 1 To first_day_week - 1
            date_count = first_day - (first_day_week - week_count)
            Me("DayTgl" & week_count & "_1").Caption = Day(date_count)
            Me("DayTgl" & week_count & "_1").ForeColor = RGB(150, 150, 150)
        Next
    End If
    
    '1日移行の日付をセットする
    If first_day_week < 7 Then
        week_count = 0
        For week_count = first_day_week + 1 To 7
            date_count = first_day - (first_day_week - week_count)
            Me("DayTgl" & week_count & "_1").Caption = Day(date_count)
            Me("DayTgl" & week_count & "_1").ForeColor = RGB(0, 0, 0)
        Next
    Else
        date_count = first_day
    End If
    
    '2週目移行の日付をセットする
    For week_zone_count = 2 To 6
        week_count = 0
        For week_count = 1 To 7
            date_count = DateAdd("D", 1, date_count)
            Me("DayTgl" & week_count & "_" & week_zone_count).Caption = Day(date_count)
            
            If Month(date_count) = Month(first_day) Then
                Me("DayTgl" & week_count & "_" & week_zone_count).ForeColor = RGB(0, 0, 0)
            Else
                Me("DayTgl" & week_count & "_" & week_zone_count).ForeColor = RGB(150, 150, 150)
            End If
        Next
    Next
    
    Call DaySelect
End Sub

' 先月に移動
Private Sub MonthDownButton_Click()
    Selected_Date = DateAdd("M", -1, Selected_Date)
    Me.SelectedDateTextBox.Value = Selected_Date
    Me.YearTextbox.Value = Year(Selected_Date)
    Me.MonthTextbox.Value = Month(Selected_Date)
    Call CalenderCreate
    Call SetDate
End Sub

' 翌月に移動
Private Sub MonthUpButton_Click()
    Selected_Date = DateAdd("M", 1, Selected_Date)
    Me.SelectedDateTextBox.Value = Selected_Date
    Me.YearTextbox.Value = Year(Selected_Date)
    Me.MonthTextbox.Value = Month(Selected_Date)
    Call CalenderCreate
    Call SetDate
End Sub

' 去年に移動
Private Sub YearDownButton_Click()
    Selected_Date = DateAdd("yyyy", -1, Selected_Date)
    Me.SelectedDateTextBox.Value = Selected_Date
    Me.YearTextbox.Value = Year(Selected_Date)
    Me.MonthTextbox.Value = Month(Selected_Date)
    Call CalenderCreate
    Call SetDate
End Sub

' 来年に移動
Private Sub YearUpButton_Click()
    Selected_Date = DateAdd("yyyy", 1, Selected_Date)
    Me.SelectedDateTextBox.Value = Selected_Date
    Me.YearTextbox.Value = Year(Selected_Date)
    Me.MonthTextbox.Value = Month(Selected_Date)
    Call CalenderCreate
    Call SetDate
End Sub

'現在の選択日からトグルの日付をセットする
Private Sub DaySelect()
    Dim week_count As Integer
    Dim week_zone_count As Integer
    Dim day_count As Integer
    
    For week_zone_count = 1 To 6
        For week_count = 1 To 7
            day_count = Me("DayTgl" & week_count & "_" & week_zone_count).Caption
            If week_zone_count = 1 And day_count >= 8 Then
                '1週目で8以上の数値は先月扱いとする
            ElseIf week_zone_count >= 5 And day_count <= 15 Then
                '5週目移行で15以下の数値は来月扱いとする
            Else
                If day_count = Day(Selected_Date) Then
                    Me.Days.Value = Me("DayTgl" & week_count & "_" & week_zone_count).OptionValue
                    Exit Sub
                End If
            End If
        Next
    Next
End Sub

使い方

フォームを開く時にOpenArgsに日付で使うフォーム名とテキストボックスの名前をセットする事で連携を実現しています。

TestForm.cls
Private Sub DateTextBox_Click()
    DoCmd.OpenForm "CalenderForm", acNormal, , , , , "TestForm,DateTextBox"
End Sub

その他

選択後にフォームを閉じる動作を行わせたい場合は

CalenderForm.cls
Private Sub SetDate()
    Forms(Form_Name).Controls(Date_Control_Name).Value = Format(Selected_Date, "yyyy/mm/dd")
    DoCmd.Close acForm, Me.Name
End Sub

とすれば良さそうに見えますが、
これだと最初から選択されている日付をクリックした時に閉じませんので
カレンダーのトグルボタン全てに MouseDownイベント を設定する必要があります。

おわりに

Excelもそうですけどカレンダーを再現するのって結構良い練習になるなぁと思いました。

2
5
3

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?