| |
> はい、漠然としていますが、なんとなく意味は理解できました。
> clickもしていないのに、click時の値が取得できるというのが、いまひとつ納得できていないのですが
ちょっと分かりにくいしので、Tagプロパティにも日付を格納するように
CalUpdate を改良しました。これで後から日付を利用するときシンプルな
コードになりますので。
Private Sub CalUpdate(y As Integer, m As Integer)
Dim i As Integer, j As Integer, FirstDay As Date, s As Integer
For j = 0 To 1
FirstDay = DateSerial(y, m + j, 1)
s = Weekday(FirstDay)
For i = 0 To Day(DateSerial(y, m + j + 1, -1))
With Me(Chr(Asc("d") + j) & i + s)
.Caption = Day(FirstDay + i)
.OnClick = "=Day_Click(#" & FirstDay + i & "#)"
.Tag = FirstDay + i '※この行を追加
End With
Next
Next
End Sub
> 詳細欄に生徒さんの一覧がある中で、受講日である「曜日」のフィールドがあり、
> 例えば火曜日のクラスの生徒さんなら、currentイベントで、６ヶ月分のカレンダー
> すべての火曜日に色を付けたいと思いました。
> その火曜日中で、出席した日だけを色を濃くするという仕様にしようと思い、
Private Sub SetColor(y As Integer, m As Integer)
Dim i As Integer, j As Integer
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT * FROM 出欠 " & _
"WHERE 生徒番号=" & Me.生徒番号 & " AND " & _
"出席日 Between #" & DateSerial(y, m + 0, 1) & _
"# AND #" & DateSerial(y, m + 2, 0) & "#"
Set db = CurrentDb()
Set RS = db.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
For j = -3 To 2
For i = 1 To 42
With Me(Chr(Asc("d") + j) & i)
If .OnClick= "" Then
.BackColor = vbWhite
Else
RS.FindFirst "出席日=#" & .Tag & "#")(1) & "#"
If RS.NoMatch Then
If WeekdayName(Weekday(.Tag)) = Me.曜日 Then
.BackColor = vbMagenta
Else
.BackColor = vbWhite
End If
ElseIf RS!出欠 Then
.BackColor = vbBlue
Else
.BackColor = vbRed
End If
End If
End With
Next
Next
RS.Close
End Sub
|
|
hatena
- 07/7/7(土) 11:08 -
![[未読]](./data/access/image/read_icon.gif){kind=icon}
