이 기사는 Access2016을 사용하고 있습니다.

ActiveX 컨트롤의 「Microsoft Date and Time Picker Control 6.0」을 사용하면 심플하고 깔끔한 디자인의 컨트롤을 사용할 수 있습니다.

하지만 Windows 10 업데이트로 인해 표시가 무너지거나 원래 향후 지원되지 않게 될지도 모릅니다.

그래서 비슷한 움직임을 하는 폼을 만들어 보았습니다.

완성도

텍스트 상자를 클릭하면 캘린더 양식이 표시되고 캘린더 양식에서 날짜를 선택하면 텍스트 상자의 내용이 변경된다는 양식을 만들었습니다.
덧붙여서 Access2000 이후에 대응하고 있습니다.

양식 만들기

양식의 구성은 레이블을 제외하고 다음과 같습니다.


종류
이름
용도


명령 버튼
YearUpButton
1년 늘리다

명령 버튼
YearDownButton
일년 감소

명령 버튼
MonthUpButton
한 달 늘리다

명령 버튼
MonthDownButton
1월 감소

옵션 그룹
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도 그렇습니다만 캘린더를 재현하는 것은 상당히 좋은 연습이 된다고 생각했습니다.