Access フォームとして必要と思われるものに近いことを行うことはできますが、簡単ではありません。このスクリーン キャプチャは、レコード ソースが ADO 切断レコードセットであるデータシート ビューフォームにサンプル データを表示します。テキスト ボックスの値が Null でない場合、条件付き書式を使用してテキスト ボックスの背景色を設定します。あなたの写真はコースごとに異なる色を示唆していましたが、同じ時間ブロックで複数のコースをスケジュールできる場合、それを扱いたくありませんでした...私の方法は対処が簡単でした. :-)
切断されたレコードセットを作成してロードするコードは、以下に含まれていますGetRecordset()。フォームの open イベントは、そのレコードセットを に設定しますGetRecordset()。
Private Sub Form_Open(Cancel As Integer)
Set Me.Recordset = GetRecordset
End Sub
サンプルデータを別の方法で保存したことに注意してください。ここに私のClass_sessionsテーブルがあります：
Course day_of_week start_time end_time
------ ----------- ---------- -----------
PSY 1 2 8:00:00 AM 9:00:00 AM
PSY 1 4 8:00:00 AM 9:00:00 AM
SOC 150 2 8:00:00 AM 11:00:00 AM
ANTH 2 3 8:00:00 AM 9:00:00 AM
ANTH 199 2 8:00:00 AM 9:00:00 AM
ANTH 199 4 8:00:00 AM 9:00:00 AM
これは、このアプローチの重要な部分である切断されたレコードセットを作成する機能です。これは、" Microsoft ActiveX Data Objects [version] Library "への参照を必要とするアーリー バインディングを使用して開発しました。バージョン2.8を使用しました。本番環境で使用する場合は、遅延バインディングを使用するようにコードを変換し、参照を破棄します。Intellisense を使用してその仕組みを理解できるように、アーリー バインディングのままにしました。
Public Function GetRecordset() As Object
Dim rsAdo As ADODB.Recordset
Dim fld As ADODB.Field
Dim db As DAO.Database
Dim dteTime As Date
Dim i As Long
Dim qdf As DAO.QueryDef
Dim rsDao As DAO.Recordset
Dim strSql As String
Set rsAdo = New ADODB.Recordset
With rsAdo
.Fields.Append "start_time", adDate, , adFldKeyColumn
For i = 2 To 6
.Fields.Append WeekdayName(i), adLongVarChar, -1, adFldMayBeNull
Next
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.LockType = adLockPessimistic
.Open
End With
strSql = "PARAMETERS block_start DateTime;" & vbCrLf & _
"SELECT day_of_week, Course, start_time, end_time" & vbCrLf & _
"FROM Class_sessions" & vbCrLf & _
"WHERE [block_start] BETWEEN start_time AND end_time" & vbCrLf & _
"ORDER BY day_of_week, Course;"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSql)
dteTime = #7:00:00 AM#
Do While dteTime < #6:00:00 PM#
'Debug.Print "Block start: " & dteTime
rsAdo.AddNew
rsAdo!start_time = dteTime
rsAdo.Update
qdf.Parameters("block_start") = dteTime
Set rsDao = qdf.OpenRecordset(dbOpenSnapshot)
Do While Not rsDao.EOF
'Debug.Print WeekdayName(rsDao!day_of_week), rsDao!Course
rsAdo.Fields(WeekdayName(rsDao!day_of_week)) = _
rsAdo.Fields(WeekdayName(rsDao!day_of_week)) & _
rsDao!Course & vbCrLf
rsAdo.Update
rsDao.MoveNext
Loop
dteTime = DateAdd("h", 1, dteTime)
Loop
rsDao.Close
Set rsDao = Nothing
qdf.Close
Set qdf = Nothing
Set GetRecordset = rsAdo
End Function
