您可以做一些接近您似乎想要的访问表单的事情,但这并不容易。此屏幕截图在数据表视图窗体中显示您的示例数据,其记录源是 ADO 断开连接的记录集。当文本框值不为 Null 时,它使用条件格式设置文本框背景颜色。您的图片为每门课程建议了不同的颜色,但是当可以在同一时间段内安排多个课程时,我不想处理这个问题……我的方式更容易应付。:-)
创建和加载断开连接的记录集的代码包含在下面的GetRecordset()
. 表单的打开事件将其记录集设置为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