Microsoft Access 掲示板

カレンダーの範囲をまたぐときにも対応できる様に処理を追加しました。

Public Sub SetSchedule()
    Dim i As Integer
    For i = 1 To 42
        Me("T" & i).Caption = ""
        Me("G" & i).Caption = ""
    Next
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 開始日, 終了日, 件名 FROM T_予定 WHERE " & _
        "終了日>#" & FirstDay & "# AND 開始日<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        Dim BeginI As Long
        BeginI = rs!開始日 - FirstDay
        If BeginI > 0 Then
            Me("T" & BeginI).Caption = rs!件名
        Else
            Me("T1").Caption = rs!件名
        End If
        
        If Not IsNull(rs!終了日) Then
            If BeginI > 0 Then
                Me("G" & BeginI).Caption = ChrW(8656) '"←"
            Else
                BeginI = 0
            End If
            
            Dim EndI As Long
            EndI = rs!終了日 - FirstDay
            If EndI <= 42 Then
                Me("G" & EndI).Caption = Me("G" & EndI).Caption & ChrW(8658) '"→"
            Else
                EndI = 43
            End If
            For i = BeginI + 1 To EndI - 1
                Me("G" & i).Caption = "＝"
            Next
        End If
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
    
End Sub

下記がサンプルファイルです。

FrmCalendar2.zip