| |
>１つのbookに両方のコードを書き込みたい
Auto_Openというタイトルのプロシージャは、イベントマクロですから
複数を設定することは出来ません。なので原則として今のように、
二つの処理を一つのプロシージャに書くことになります。
>時間で表示が出ません
OnTimeでスケジュールを設定する条件として、最初に
> If .Count(MyR) > 0 Then GoTo ELine
というコードがありますが、意味は理解してますか ? そこは
「 Worksheets(1).Range("IV1:IV4")で、時刻が一ヶ所でも入力されていたら
ラベルのところへ飛んでOnTimeの設定を中止する」という意味です。
一方、既に設定されたスケジュールが実行されたとき、IV1:IV4のいずれかの
セルの値はクリアされるようにしてあります。4つのスケジュール全てが
実行されたとき、初めて Application.Count(MyR) の戻り値が 0 になって
一日分のスケジュールが再設定されるわけです。その点、先のスレッドにも
"重複設定されないように"と説明しておいたはずですよ。
で、どうしても設定済みのスケジュールを解除して、一から設定し直したいなら
Sub Auto_Open()
Dim MyR As Range
Randomize ' 乱数発生ルーチンを初期化します。
Select Case Int(100 * Rnd + 1)
Case 1 To 10: MsgBox "血圧は正常ですか？"
Case 11 To 20: MsgBox "今日のあなたの運勢は○吉です"
Case 21 To 30: MsgBox "今日もお仕事頑張るぞ！"
Case 31 To 40: MsgBox "昨日の夕飯何食べました？"
Case 41 To 50: MsgBox "おとといの朝食はなに？
Case 51 To 60: MsgBox "今日はいくら稼ぎましたか？"
Case 61 To 70: MsgBox "今日は残業無しで帰りましょう。
Case 71 To 80: MsgBox "今日のあなたの運勢は○凶です。
Case 81 To 90: MsgBox "貴方の名前・年齢・血液型は？
Case 91 To 100: MsgBox "お元気ですか・・・？"
End Select
With Worksheets(1)
.Unprotect
Set MyR = .Range("IV1:IV4")
End With
With Application
If .Count(MyR) > 0 Then GoTo ELine
If IsEmpty(MyR.Cells(1)) And _
Time < TimeValue("02:48:00") Then
.OnTime TimeValue("02:48:00"), "MyScd"
MyR.Cells(1).Value = "02:49:00"
End If
If IsEmpty(MyR.Cells(2)) And _
Time < TimeValue("11:55:00") Then
.OnTime TimeValue("11:55:00"), "MyScd"
MyR.Cells(2).Value = "11:56:00"
End If
If IsEmpty(MyR.Cells(3)) And _
Time < TimeValue("15:00:00") Then
.OnTime TimeValue("15:00:00"), "MyScd"
MyR.Cells(3).Value = "15:01:00"
End If
If IsEmpty(MyR.Cells(4)) And _
Time < TimeValue("17:00:00") Then
.OnTime TimeValue("17:00:00"), "MyScd"
MyR.Cells(4).Value = "17:01:00"
End If
End With
ELine:
Worksheets(1).Protect: Set MyR = Nothing
End Sub
'↓これを追加
Sub Auto_Close()
Dim C As Range
Dim Tm As Date
Dim Ans As Integer
With Worksheets(1)
.Unprotect
If Application.Count(.Range("IV1:IV4")) > 0 Then
For Each C In .Range("IV1:IV4").SpecialCells(2, 1)
Tm = DateAdd("n", -1, C.Value)
Ans = MsgBox(Tm & " のスケジュールは実行されていません" _
& vbLf & "このまま中止しますか", 36)
If Ans = 6 Then Application.OnTime Tm, "MyScd", , False
Next
End If
.Protect
End With
ThisWorkbook.Save
End Sub
'↓これは変更無し
Sub MyScd()
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
With Worksheets(1)
If Time < .Range("IV1").Value Then
WshShell.Popup "休憩時間ですよ", 7, , 64
.Range("IV1").Clear
ElseIf Time < .Range("IV2").Value Then
WshShell.Popup "そろそろ昼食の時間です", 7, , 64
.Range("IV2").Clear
ElseIf Time < .Range("IV3").Value Then
WshShell.Popup "お茶の時間ですよ", 7, , 64
.Range("IV3").Clear
ElseIf Time < .Range("IV4").Value Then
WshShell.Popup "終了時間ですよ", 7, , 64
.Range("IV4").Clear
End If
End With
Set WshShell = Nothing
End Sub
よく意味を調べてから使うように。
なお
>TimeValue("02:48:00")
は、24時間制なら午前２時になることを承知してますね ?
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
