スケジュール管理表を作成 ⑧ 前日の続きからシート作成

先日から、スケジュール管理表をExcelで作成している。
infoment.hatenablog.com
今日も、前回の続きから。
f:id:Infoment:20210121222700p:plain
例えば、こんな感じで一日を終えたとする。
f:id:Infoment:20210121222850p:plain
この日最後に終えた案件Ｆについて、実は二通りのパターンがある。

きっちり最後まで終えて帰宅した。
志半ばで時間切れ。翌日朝から仕切り直しだ。

そこで、翌日のシートを作成するとしたら、仕切り直しパターンを想定して
前日最後の仕事から始めたほうがよさそうだ。

↓ 翌日。
f:id:Infoment:20210121223248p:plain

また、毎朝の定例業務がある場合は、それも差し込んでおきたい。専用の
テーブルを作成するとしよう。

↓ 定例業務シート。
f:id:Infoment:20210121223401p:plain

↓ 定例業務テーブル。
f:id:Infoment:20210121223450p:plain

それでは、前日シートから当日シートを作成する「作成」ボタンを作成しよう。
（ややこしい）。
f:id:Infoment:20210121223810p:plain
ボタンのオブジェクト名は「cb作成」とした。

↓ シートモジュール。

Private Sub cb作成ボタン_Click()
    Call MakeNewSheet
End Sub

↓ 標準モジュール。

Public Sub MakeNewSheet()
    Dim NewSheetName As String
        NewSheetName = Format(Date, "m月d日（aaa）")
    Dim Ws As Worksheet
        For Each Ws In Worksheets
            If Ws.Name = NewSheetName Then
                MsgBox "本日のシートは作成済みです。"
                Exit Sub
            End If
        Next

    Dim NewSheet As Worksheet
        ActiveSheet.Copy After:=ActiveSheet
    Set NewSheet = ActiveSheet
        NewSheet.Name = NewSheetName
        NewSheet.Range("終業予定") = "17:00"
    Dim Tb As ListObject
    Set Tb = NewSheet.ListObjects(1)
        Tb.Name = "Table_" & Format(Date, "yyyymmdd")
        
    ' 前日終えた業務のうち、一番最後以外を削除。
    Dim DeleteFlag As Boolean
    Dim i As Long
        For i = Tb.ListRows.Count To 1 Step -1
            If Tb.ListRows(i).Range(列名.en終了時刻) <> vbNullString Then
                If Not DeleteFlag Then
                    DeleteFlag = True
                    Tb.ListRows(i).Range(列名.en終了時刻) = vbNullString
                Else
                    Tb.ListRows(i).Delete
                End If
            End If
        Next
    
    ' 定例業務追加（定例業務シートをSheet0とし、定例業務テーブルをTbとした）。
    Dim arr As Variant
        If Sheet0.Tb.ListRows.Count <> 0 Then
            arr = Sheet0.Tb.DataBodyRange
            For i = 1 To UBound(arr)
                Tb.ListRows.Add 1
            Next
            Tb.DataBodyRange.Cells(1, 2).Resize(UBound(arr), 2) = arr
        End If
        
    Call UpdateTable
End Sub