再質問 エクセル VBAについて やりたいこと 指定のセルに時間を入力したあと、この入力された時間から40分後にメッセージボックスを出したいです。

Visual Basic | Visual Basic84閲覧xmlns="http://www.w3.org/2000/svg">250

ベストアンサー

0

ご回答ありがとうございます。私も、こちらのサイト含め多々調べて組んでみたのですが、どうしてもうまくいきません。 今考えているのは、 ①指定のセルに時間を入力したら、②を実行 ②①で入力した時間+40分ー入力した時点での現在時刻の差の時間を算出し、その差の時間が経過(又はその差の時間だけマクロの実行を中断)したら、③を実行 ③40分経過のメッセージボックスを出す。 です。 素人ですので、できれば、コードを含めて教えていただけると助かります。

ThanksImg質問者からのお礼コメント

本当に助かりました! ありがとうございました!

お礼日時:10/15 11:06

その他の回答(1件)

1

他回答にあるようにOnTimeメソッドを使うのが良いと思いますよ。 下記サンプルを参考にして下さい サンプルの前提 ・時刻を入力するセル:Sheet1のA1セル .....セルの書式は文字型で HH:MM 型式文字列で入力(当日の時刻とする) ・A1セルが "" だったら 登録されているOnTimeをキャンセルする ・何分後かは Const Wait時間で定義 ・何分以上後ならエラーにするかをConst Lim時間で定義 ・メッセージを出す時刻が現時刻以前ならエラー ・Ontimeで実行するSubの名前はConst OnTimeProcで定義 これらについてはそちらのニーズにあわせてConstの値を修正して下さい ★注 Const OnTimeProc = "Sheet1.TimeUpProc"の Sheet1 の部分は プロジェクトエクスプローラ(添付図)の シート名の()の外の部分...つまり Sheet1(Test)のTestではなく Sheet1を書いて下さい --- Sheet1(Test) のシートモジュール -------- Option Explicit Private Const 時刻セル = "A1" '★ 時刻を入力するセルを定義して下さい Private Const Wait時間 = "0:40:0" '★ 何分後にメッセージを出すかをHH:MM:SS型式でを定義して下さい Private Const Lim時間 = "8:0:0" '★ 何分後以降だったらエラーとするかをHH:MM:SS型式でを定義して下さい Private Const OnTimeProc = "Sheet1.TimeUpProc" '★TimeUp時、実行するSubの名前を入力して下さい Dim TargetTime As Date Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Err Dim Dt, LimTime As Date If Not (Intersect(Range(時刻セル), Target) Is Nothing) Then If Target <> "" Then Dt = CDate(Format(Now, "YYYY/MM/DD ") & Target) ' 指定時刻 TargetTime = Dt + TimeValue(Wait時間) LimTime = Now + TimeValue(Lim時間) If TargetTime <= Now Then MsgBox "既にアラーム時刻を過ぎています" Exit Sub End If If TargetTime >= LimTime Then MsgBox "アラーム時刻が遅すぎます" Exit Sub End If ResetOnTime '既にOnTimeが登録されていたらリセットする Application.OnTime TargetTime, OnTimeProc 'TargetTime時刻にTimerProc Sub を実行する様に登録 Else ResetOnTime '既にOnTimeが登録されていたらリセットする End If End If Exit Sub Err: MsgBox "時刻が不正です" End Sub Private Sub TimeUpProc() MsgBox "Wait時間です" End Sub Private Sub ResetOnTime() On Error Resume Next Application.OnTime TargetTime, OnTimeProc, , False '既に登録されていたらリセットする End Sub -------------------------------------------------

画像

1人がナイス!しています