【Access VBA】１ヶ月分のレコードを日付ごとの一覧表示にする

Public Sub LabelRename()
    Dim i As Long
    Dim n As Long
    Dim r As Long
    Dim c As Long
    
    With Forms!F_予約月間一覧
        For i = 0 To 30
            .Controls("ラベル" & i).Caption = "D" & i + 1
            .Controls("ラベル" & i).Name = "D" & i + 1
        Next
        
        For r = 1 To 31
            For c = 1 To 10
                n = 30 * c + c + r - 1
                .Controls("ラベル" & n).Caption = "T" & r & "_" & c
                .Controls("ラベル" & n).Name = "T" & r & "_" & c
            Next c
        Next r
    End With

End Sub

Public Function LabelSetSize()
    Const CalLeft = 0.2 * 567  'カレンダー 左位置 0.2cm
    Const CalTop = 0.2 * 567     'カレンダー 上位置 1cm
    Const ColWidth = 3 * 567   '列幅　2cm
    Const DHeight = 0.8 * 567 '列幅　0.55cm
    Const THeight = 0.8 * 567  '列幅　1.5cm
    Dim i As Long
    Dim Row As Integer, Col As Integer
     
    With Forms!F_予約月間一覧
        For i = 1 To 31
            Row = i - 1
            .Controls("D" & i).Move _
            0 * ColWidth + CalLeft, _
            Row * (DHeight) + CalTop, _
            ColWidth, DHeight
            For j = 1 To 10
                Col = j
                
                .Controls("T" & i & "_" & j).Move _
                    Col * ColWidth + CalLeft, _
                    Row * (THeight) + CalTop, _
                    ColWidth, THeight
            Next j
        Next i
    End With
 End Function

Private Sub btn月間一覧_Click()
    DoCmd.OpenForm "F_予約月間一覧"
End Sub

Private Sub Form_Load()
    Me.btnPrev.OnClick = "=MoveMonth(-1)"
    Me.btnNext.OnClick = "=MoveMonth(1)"
    Me.tx表示年 = Forms!F_予約フォーム.tx表示年
    Me.tx表示月 = Forms!F_予約フォーム.cmb表示月
    SetCalendar
End Sub

Private Function SetCalendar()
    Dim i As Integer, j As Integer, D As Date, m As Integer, n As Integer
    Dim term As Integer
    Dim dayBuf As Variant

    term = 30
    m = Me.tx表示月
    FirstDay = DateSerial(Me.tx表示年, m, 1)
    For i = 1 To 31
        With Me("D" & i)
            D = FirstDay + i - 1
'            .Caption = Day(D)
            If Weekday(D) = 1 Then
                .ForeColor = vbRed      '日曜は赤文字
            ElseIf Weekday(D) = 7 Then
                .ForeColor = vbBlue     '土曜は青文字
            Else
                .ForeColor = vbBlack
            End If
            n = Month(D)
            If m = n Then
                .Caption = Format(D, "yyyy/mm/dd(aaa)")
                .FontSize = 11
            Else
                .Caption = ""
                If term = 30 Then
                    term = i - 2
                End If
            End If
        End With
        
        For j = 1 To 10
            Me("T" & i & "_" & j).Caption = ""
        Next j
    Next i
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 日付,開始時間,終了時間,氏名 FROM Q_予約台帳_選択 WHERE " & _
        "日付>=#" & FirstDay & "# AND 日付<=#" & FirstDay + term & "#", _
        dbOpenForwardOnly, dbReadOnly)
    
    Do Until rs.EOF
        If dayBuf <> rs!日付 Then
            j = 1
            dayBuf = rs!日付
        Else
            j = j + 1
        End If

        With Me("T" & rs!日付 - FirstDay + 1 & "_" & j)
            .Caption = .Caption & rs!氏名 & vbCrLf & Format(rs!開始時間, "h:mm") & "～" & Format(rs!終了時間, "h:mm")
        End With
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
        
End Function

Private Function MoveMonth(n As Integer)
    Dim D As Date
    D = DateAdd("m", n, DateSerial(Me.tx表示年, Me.tx表示月, 1))
    Me.tx表示年 = Year(D)
    Me.tx表示月 = Month(D)
    SetCalendar
    DoEvents
End Function