aa

‘ Windows API の宣言
Private Declare PtrSafe Function ExitWindowsEx Lib “user32” (ByVal uFlags As Long, ByVal dwReason As Long) As Long
Private Const EWX_LOGOFF As Long = &H0 ‘ ログオフ
Private Const SHTDN_REASON_MAJOR_OTHER As Long = &H0 ‘ 理由コード

Dim alarmSet As Boolean ‘ アラームがセットされているか
Dim targetTime As Date ‘ 設定された時刻

‘ 初期設定: 現在時刻と設定時刻を表示
Sub InitializeAlarmClock()
With ThisWorkbook.Sheets(1)
‘ ヘッダー設定
.Cells(3, 3).Value = “現在時刻 (時)”
.Cells(3, 4).Value = “現在時刻 (分)”
.Cells(3, 5).Value = “現在時刻 (秒)”
.Cells(5, 3).Value = “設定時刻 (時)”
.Cells(5, 4).Value = “設定時刻 (分)”
.Cells(5, 5).Value = “設定時刻 (秒)”

‘ セルのフォーマット設定
.Cells(4, 3).NumberFormat = “00”
.Cells(4, 4).NumberFormat = “00”
.Cells(4, 5).NumberFormat = “00”
.Cells(6, 3).NumberFormat = “00”
.Cells(6, 4).NumberFormat = “00”
.Cells(6, 5).NumberFormat = “00”
End With
alarmSet = False
SetAlarmTime
UpdateClock ‘ 現在時刻の更新を開始
End Sub

‘ 現在時刻を更新
Sub UpdateClock()
Dim sheet As Worksheet
Static prevTime As Date ‘ 以前のタイマー時間を記録

Set sheet = ThisWorkbook.Sheets(1)

‘ 以前のスケジュールを解除
On Error Resume Next
Application.OnTime prevTime, “UpdateClock”, , False
On Error GoTo 0

‘ 現在時刻をセルに分割して表示
sheet.Cells(4, 3).Value = Hour(Now)
sheet.Cells(4, 4).Value = Minute(Now)
sheet.Cells(4, 5).Value = Second(Now)

‘ アラームがセットされている場合
If alarmSet Then
‘ 現在時刻が設定時刻を超えたら
If Now >= targetTime Then
LogoutPC
Exit Sub ‘ 一度アラームを処理した後に終了
End If
End If

‘ 次回のスケジュールを設定
prevTime = Now + TimeValue(“00:00:01”)
Application.OnTime prevTime, “UpdateClock”
End Sub

‘ 設定時刻を取得
Sub SetAlarmTime()
Dim inputHour As Variant, inputMinute As Variant, inputSecond As Variant
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets(1)

‘ セルの値を取得
inputHour = sheet.Cells(6, 3).Value
inputMinute = sheet.Cells(6, 4).Value
inputSecond = sheet.Cells(6, 5).Value

‘ 時・分・秒の入力がすべて揃っているか確認
If IsEmpty(inputHour) Or IsEmpty(inputMinute) Or IsEmpty(inputSecond) Then
If Not alarmSet Then ‘ メッセージボックスを一度だけ表示
MsgBox “時・分・秒をすべて入力してください。”, vbExclamation
End If
Exit Sub
End If

‘ 数値以外の場合のエラーチェック
If Not IsNumeric(inputHour) Or Not IsNumeric(inputMinute) Or Not IsNumeric(inputSecond) Then
MsgBox “時・分・秒には数値を入力してください。”, vbExclamation
Exit Sub
End If

‘ 入力を時刻に変換
On Error Resume Next
targetTime = TimeSerial(CInt(inputHour), CInt(inputMinute), CInt(inputSecond))
On Error GoTo 0

‘ 無効な場合のエラーハンドリング
If targetTime = 0 Then
MsgBox “無効な時刻形式です。時・分・秒を正しく入力してください。”, vbExclamation
Exit Sub
End If

‘ targetTime に日付を補完
If targetTime < Time Then targetTime = Date + 1 + TimeValue(Format(targetTime, "hh:mm:ss")) ' 翌日に設定 Else targetTime = Date + TimeValue(Format(targetTime, "hh:mm:ss")) ' 当日に設定 End If alarmSet = True MsgBox "アラームを " & Format(targetTime, "yyyy/mm/dd hh:mm:ss") & " にセットしました。", vbInformation End Sub Sub LogoutPC() On Error Resume Next ' 現在のタイマーを解除 Dim prevTime As Date prevTime = Now + TimeValue("00:00:01") Application.OnTime prevTime, "UpdateClock", , False ' タイマーを解除 ' 自動保存とエクセル終了 ThisWorkbook.Save ThisWorkbook.Saved = True Application.Quit ' エクセル終了 ' Windows ログアウト実行 ExitWindowsEx EWX_LOGOFF, SHTDN_REASON_MAJOR_OTHER End Sub

関連記事