1日のスケジュールをリアルタイムで記録して円グラフにするマクロ

Sub Add()

Dim count As Long
Dim current_time As Date
Dim midnight As Date

'記録されているタスクの個数を調べる
count = WorksheetFunction.count(Range(Cells(3, 1), Cells(26, 1)))

'現在時刻を取得
current_time = Format(Time, "hh:mm")

'24:00
midnight = 1

'現在のタスクの終了時刻を入力
Cells(3 + count - 1, 2) = current_time

'現在のタスクの所要時間を計算，入力
Cells(3 + count - 1, 4) = Cells(3 + count - 1, 2) - Cells(3 + count - 1, 1)

'次のタスクの開始時刻と終了時刻(仮)を入力
Cells(3 + count - 1 + 1, 1) = current_time
Cells(3 + count - 1 + 1, 2) = midnight

'現在のタスクの所要時間を計算，入力
Cells(3 + count - 1 + 1, 4) = midnight - current_time

End Sub

Sub New_sheet()

Dim count As Long
Dim current_date As Date
    
'アクティブなシートを先頭・一番左にコピーする
ActiveSheet.Copy Before:=Sheets(1)

'記録されているタスクの個数を調べる
count = WorksheetFunction.count(Range(Cells(3, 1), Cells(26, 1)))

'記録されているタスクを全て削除
Range(Cells(3, 1), Cells(3 + count - 1, 4)).ClearContents

'デフォルトのタスクの開始時刻と終了時刻，所要時間を入力
Cells(3, 1) = 0 '0:00
Cells(3, 2) = 1 '24:00
Cells(3, 4) = 1 - 0 '24:00-0:00

On Error Resume Next 'エラーが出た場合，次の行から処理を再開する

'新しいシートの名前を現在の日付”○月〇日(〇)”に変更する
'すでに同じ名前のシートがあった場合この処理は行われない
ActiveSheet.Name = Month(Date) & "月" & Day(Date) & "日(" & WeekdayName(Weekday(Date), True) & ")"

End Sub