Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


38977 / 76732 ←次へ | 前へ→

【42876】Re:1つにできますか?
回答  Kein  - 06/9/24(日) 13:56 -

引用なし
パスワード
   >1つの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時間制なら午前2時になることを承知してますね ?
0 hits

【42873】1つにできますか? まーくん 06/9/24(日) 3:34 質問
【42876】Re:1つにできますか? Kein 06/9/24(日) 13:56 回答
【42878】Re:1つにできますか? まーくん 06/9/24(日) 16:34 発言
【42883】Re:1つにできますか? Kein 06/9/24(日) 17:21 発言
【42899】Re:1つにできますか? まーくん 06/9/25(月) 1:04 発言
【42908】Re:1つにできますか? まーくん 06/9/25(月) 11:21 発言
【42961】Re:1つにできますか? まーくん 06/9/28(木) 2:30 発言

38977 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free