Microsoft Access 掲示板

カレンダー形式のスケジュール管理フォーム作成時における、日付の色を変更したい。

34 コメント
views
4 フォロー

いつも大変参考にさせて頂いております。
この度【カレンダー形式のスケジュール管理フォーム作成】を利用させて頂きました。

※※※より以下の部分を参考にさせていただいているのですが

T_休日 備考 に
【A】と入力した場合⇒カレンダーの文字を【緑色】に
【B】と入力した場合⇒カレンダーの文字を【青色】に
それ以外は【赤色】のままで

…としたいのですが、どのように記述すればよろしいのでしょうか…。
ご教授いただけませんでしょうか
よろしくお願いします。


※※※
お世話になります。
カレンダー作成させて頂きスケジュールの管理をしたいのですが、
指定した休日を設定するようなやり方教えて頂けないでしょうか?
アドバイスよろしくお願い致します。

2012.02.0411:07 |URL | #8BaZKrGo [edit]

hatena says...""

休日を登録するテーブルを作成します。

T_休日
日付 日付/時刻型 主キー
備考 テキスト型

記事のコードの日にち設定関数を下記ように変更します。(※がついてる行は修正箇所です。)

'カレンダー 日にち設定関数
Private Function SetCalendar()
Dim i As Integer, D As Date, m As Integer, n As Integer

  m = Me.月
  FirstDay = DateSerial(Me.年, m, 1)
  FirstDay = FirstDay - Weekday(FirstDay)
  For i = 1 To 42
    With Me("D" & i)
      D = FirstDay + i
      .Caption = Day(D)
      .ControlTipText = Nz(DLookup("備考","T_休日","日付=#" & D & "#")) '※ 休日の備考をヒントテキストに設定
      If Weekday(D) = 1 Or .ControlTipText <> "" Then '※
        .ForeColor = vbRed  '日曜または祝日は文字色 赤
      ElseIf Weekday(D) = 7 Then
        .ForeColor = vbBlue  '土曜は文字色 青
      Else
        .ForeColor = vbBlack
      End If
      n = Month(D)
      If m = n Then
        .FontSize = 11
      Else
        .FontSize = 8 '月が異なるときは文字を小さく
      End If
    End With
    Me("T" & i).Caption = ""
  Next

End Function

以上です。下記もご参考に。

http://hatenachips.blog34.fc2.com/blog-entry-187.html$カレンダー形式のスケジュール管理フォーム作成 その2

OMOTI
作成: 2020/04/15 (水) 17:24:35
通報 ...
1
hatena 2020/04/15 (水) 20:26:18 修正

下記のように変更すればいいでしょう。

'カレンダー 日にち設定関数
Private Function SetCalendar()
Dim i As Integer, D As Date, m As Integer, n As Integer

  m = Me.月
  FirstDay = DateSerial(Me.年, m, 1)
  FirstDay = FirstDay - Weekday(FirstDay)
  For i = 1 To 42
    With Me("D" & i)
      D = FirstDay + i
      .Caption = Day(D)
      .ControlTipText = Nz(DLookup("備考","T_休日","日付=#" & D & "#")) '※ 休日の備考をヒントテキストに設定
      If .ControlTipText = "【A】" Then 
              .ForeColor = vbGreen '【A】は文字色 緑
      ElseIf Weekday(D) = 7 Or .ControlTipText = "【B】" Then
        .ForeColor = vbBlue  '土曜または【B】は文字色 青
      ElseIf Weekday(D) = 1 Or .ControlTipText <> "" Then '※
        .ForeColor = vbRed  '日曜または祝日は文字色 赤
      Else
        .ForeColor = vbBlack
      End If
      n = Month(D)
      If m = n Then
        .FontSize = 11
      Else
        .FontSize = 8 '月が異なるときは文字を小さく
      End If
    End With
    Me("T" & i).Caption = ""
  Next

End Function
2
OMOTI 2020/04/16 (木) 10:16:45 05554@4b4f6

早速のお返事ありがとうございます。
無事、設定することができました。
本当にありがとうございました。

3
OMOTI 2020/04/21 (火) 15:34:14 05554@4b4f6

いつもありがとうございます。
数カ所分からないところがあるので、教えてください。

1.件名の前に時刻を表示したい(例 10:00 〇〇と打ち合わせ)
2.件名の行間を狭めたい(複数あると枠外になって見えない為)
3.過去日の内容も表示しておきたい

よろしくお願い致します。

'予定表示プロシージャ
Public Sub SetSchedule()
Dim i As integer, rs As DAO.Recordset
    For i = 1 To 42
        Me("T" & i).Caption = ""
    Next
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 日付, 件名 FROM T予定 WHERE " &
        "日付>#" & FirstDay & "# AND 日付<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        With Me("T" & rs!日付 - FirstDay)
            .Caption = .Caption & rs!件名 & vbCrLf & vbCrLf
        End With
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
End Sub

4
OMOTI 2020/04/21 (火) 15:50:08 05554@4b4f6

カレンダー形式のスケジュール管理フォーム作成 その2

の部分について教えてください。
クリックした日付の背景色を変更することはできました。
しかし、最上段の左から3番目の枠が常に白色のままです。(月を変更しても その部分だけ白色のまま)
どこで間違えたのでしょうか…

ご教授いただけませんでしょうか…

'フォーム 開くとき
Private Sub Form_Open(Cancel As Integer)
Dim i As Integer

    For i = 1 To 42
        Me("T" & i).OnClick = "=SetDate(" & i & ")"
    Next
    Me.cmdprev.OnClick = "=MoveMonth(-1)"
    Me.cmdNext.OnClick = "=MoveMonth(1)"
    Me.txtdate = Date
    SetCalendar
End Sub

Private Function MoveMonth(n As Integer)
    Me("T" & Me.txtdate - FirstDay).BackStyle = 0 '透明
    Me.txtdate = DateAdd("m", n, Me.txtdate)
    SetCalendar
    DoEvents
End Function

Private Function SetDate(i As Integer)
    Me("T" & Me.txtdate - FirstDay).BackStyle = 0 '透明
    Me.txtdate = FirstDay + i
    Me("T" & i).BackStyle = 1
End Function

5
OMOTI 2020/04/21 (火) 16:03:57 05554@4b4f6

すみません!!
3.過去日の内容も表示しておきたい
は無視してください

1.件名の前に時刻を表示したい(例 10:00 〇〇と打ち合わせ)
2.件名の行間を狭めたい(複数あると枠外になって見えない為)
3.過去日の内容も表示しておきたい

6

1.件名の前に時刻を表示したい(例 10:00 〇〇と打ち合わせ)
2.件名の行間を狭めたい(複数あると枠外になって見えない為)

下記のように修正してください。
行間については、改行(vbCrLf)を一つ減らしました。
もし、行間が狭すぎる場合は、デザインビューでラベルの行間を増やして調整してください。

Public Sub SetSchedule()
Dim i As Integer, rs As DAO.Recordset
    For i = 1 To 42
        Me("T" & i).Caption = ""
    Next
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 日付, 件名 FROM T_予定 WHERE " & _
        "日付>#" & FirstDay & "# AND 日付<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        With Me("T" & rs!日付 - FirstDay)
            .Caption = .Caption & rs!時刻 & " " & rs!件名 & vbCrLf
        End With
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
End Sub

しかし、最上段の左から3番目の枠が常に白色のままです。

デザインビューでそのラベルの「背景スタイル」を確認してください。「普通」になっていたら「透明」に変更してください。

7
OMOTI 2020/04/22 (水) 15:42:33 05554@4b4f6

いつもありがとうございます。
背景スタイルが「普通」になっていました。すみません。「透明」に変更すると解決しました。ありがとうございます。

1.件名の前に時刻を表示したい(例 10:00 〇〇と打ち合わせ)
↑これでつまずいています。

既存のデータをしようしているので「時刻」⇒「開始時間」と変更しています。(その他も)
黄色マーカーの部分で
エラー3265  このコレクションには項目がありません。
と表示されます。

確かに「開始時間」という項目はあるのですが…

ご教示いただけませんか?

'予定表示プロシージャ
Public Sub SetSchedule()
Dim i As Integer, rs As DAO.Recordset
    For i = 1 To 42
        Me("T" & i).Caption = ""
    Next
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 作業日, 略名 FROM Q_作業日一覧カレンダー表示用 WHERE " &
        "作業日>#" & FirstDay & "# AND 作業日<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        With Me("T" & rs!作業日 - FirstDay)
            .Caption = .Caption & rs!開始時間 & " " & rs!略名 & vbCrLf
        End With
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
End Sub

8

あっ、すみません。OpenRecordsetのSQLの方にもフィールドを追加する必要がありました。

Public Sub SetSchedule()
Dim i As Integer, rs As DAO.Recordset
    For i = 1 To 42
        Me("T" & i).Caption = ""
    Next
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 開始時間, 作業日, 略名 FROM Q_作業日一覧カレンダー表示用 WHERE " &
        "作業日>#" & FirstDay & "# AND 作業日<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        With Me("T" & rs!作業日 - FirstDay)
            .Caption = .Caption & rs!開始時間 & " " & rs!略名 & vbCrLf
        End With
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
End Sub