Microsoft Access 掲示板

Microsoft Access 掲示板

日付【開始日と終了日】の期間に矢印【⇔】のように表示したい / 5

9 コメント
views
4 フォロー
5
hatena 2020/04/02 (木) 21:56:50

ガントチャート表示用のラベルを42個、予定表示のラベルの下に配置してください。
名前は、G1 ~ G42 とします。
文字配置は「中央」にしておくといいと思います。

SetSchedule関数を下記のように修正してください。

Public Sub SetSchedule()
    Dim i As Integer
    For i = 1 To 42
        Me("T" & i).Caption = ""
        Me("G" & i).Caption = ""
    Next
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 開始日, 終了日, 件名 FROM T_予定 WHERE " & _
        "開始日>#" & FirstDay & "# AND 開始日<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        Dim BeginI As Long
        BeginI = rs!開始日 - FirstDay
        Me("T" & BeginI).Caption = rs!件名
        If Not IsNull(rs!終了日) Then
            Dim EndI As Long
            EndI = rs!終了日 - FirstDay
            Me("G" & BeginI).Caption = ChrW(8656) '"←"
            Me("G" & EndI).Caption = Me("G" & EndI).Caption & ChrW(8658) '"→"
            For i = BeginI + 1 To EndI - 1
                Me("G" & i).Caption = "＝"
            Next
        End If
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
    
End Sub

これで表示できると思います。
ただし、月またぎの予定は考慮してないので、現状のままだとエラーになるか、表示できないと思いますので、
その辺を考慮した処理を追加する必要があります。

今日のところはここまでで。明日、時間が取れたら、月またぎの部分のコードを追加します。
Furuさんの方でもまずは上記のコードの内容を理解して、可能なら月またぎの処理も考えてみてください。

通報 ...
  • 6
    名前なし 2020/04/02 (木) 23:07:06 e2559@c90e0 >> 5

    早速のお返事有難うございます。
    上記コードを理解できるように努めてみます。

    追伸；
    ちなみに月跨ぎの場合はエラー表示が出ました。
    例えば、
    月マタギの”2月”を表示した瞬間、”G59”フィールドが見つかりません。
    日付をクリックすると”T43870”フィールドが見つかりません。というのもでした。

    お時間の都合が付きましたら、教えていただけると幸いです。
    7
    hatena 2020/04/03 (金) 09:04:18 修正 >> 6

    カレンダーの範囲をまたぐときにも対応できる様に処理を追加しました。

    Public Sub SetSchedule()
    Dim i As Integer
    For i = 1 To 42
        Me("T" & i).Caption = ""
        Me("G" & i).Caption = ""
    Next
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT 開始日, 終了日, 件名 FROM T_予定 WHERE " & _
        "終了日>#" & FirstDay & "# AND 開始日<=#" & FirstDay + 42 & "#", _
        dbOpenForwardOnly, dbReadOnly)
    Do Until rs.EOF
        Dim BeginI As Long
        BeginI = rs!開始日 - FirstDay
        If BeginI > 0 Then
            Me("T" & BeginI).Caption = rs!件名
        Else
            Me("T1").Caption = rs!件名
        End If
        
        If Not IsNull(rs!終了日) Then
            If BeginI > 0 Then
                Me("G" & BeginI).Caption = ChrW(8656) '"←"
            Else
                BeginI = 0
            End If
            
            Dim EndI As Long
            EndI = rs!終了日 - FirstDay
            If EndI <= 42 Then
                Me("G" & EndI).Caption = Me("G" & EndI).Caption & ChrW(8658) '"→"
            Else
                EndI = 43
            End If
            For i = BeginI + 1 To EndI - 1
                Me("G" & i).Caption = "＝"
            Next
        End If
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
    
End Sub

    下記がサンプルファイルです。

    FrmCalendar2.zip

    8
    名前なし 2020/04/03 (金) 15:05:04 e2559@c90e0 >> 6

    早々にご対応いただき有難うございます。
    イメージしていたコードより思いの外複雑でしたが、勉強になりました。
    今後ともよろしくお願いいたします。