• ベストアンサー
  • 困ってます

VBAで指定時刻まで一時停止するコード

VBA初心者です。 業務で使用するため、VBAで指定時刻まで一時停止するコードを作りたいのですが、うまくいきません。 設定したい条件は (1)当日の午前9時から実行 (2)記述しているコードの実行が終了したら、当日の午後6時まで一時停止 (このとき他の業務でExcelを使用するので、Excelの動作を止めないためにDoEventsと記述してOSに制御を移しています) (3)当日午後6時になったら、コードの実行を再開する 以上です。 今のところ、午後6時まで動作が停止せず、すぐに午後6時以降に実行したいコードが実行されてしまいます。 どういうコードを記述すればいいでしょうか?教えてください。 ------------------------------------------------------------------------------------------------------------------ ~(中略)~ Dim PauseTime As Single Dim Start As Variant Dim Finish As Date Dim TotalTime As Variant Start = Now() Do PauseTime = Start + TimeValue("08:59:20") DoEvents Loop While Now() < Finish Finish = TimeValue("18:00:03") ~(中略)~ ------------------------------------------------------------------------------------------------------------------

共感・応援の気持ちを伝えよう!

  • 回答数5
  • 閲覧数88
  • ありがとう数4

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.4

Sub testz()  Dim PauseTime As Date  PauseTime = Now() + TimeValue("0:2:0")  Do   DoEvents   'If Now() > PauseTime Then Exit Do  Loop While Now() < PauseTime  MsgBox "AAA" End Sub とすれば期待の動きになるものと思いますが、 長時間待つ間に、 他のマクロブックを開く、他のマクロを実行する といったことが行われると 課題マクロが停止してしまうんじゃないかと思います。 (未検証です。) 私だったら、 9時に行うマクロと18時に行うマクロを マクロブック単位で分け タスクスケジューラーを使います。 9時に行うマクロが正しく動作したかどうかを 18時に行うマクロでチェックしたいということであれば 例えば、 9時に行うマクロが正しく終了するときにダミーファイルを書き出し 18時に行うマクロがこのダミーファイルの有無をチェックする といった仕組みを組み込んではいかがでしょうか。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答いただいたコードで実行してみましたが、他のExcelブックが開けない状態です。タイムスケジューラーを使う方法でやることにします。 ご回答ありがとうございました!

関連するQ&A

  • VBA 制限時間を、一時停止させたい

    Excel VBAでの質問です。Excel2007使用です。 ユーザーフォームに制限時間と、制限時間を一時停止させるコマンドボタンを作りたいです。制限時間(60分)は、下ので実行できたのですが、一時停止ができるか、わかりません。 Private Sub 制限時間_Click() Dim myTime As Date Dim myLImit As Date myLImit = Now + TimeValue("1:00:00") Do While myLImit > Now DoEvents myTime = myLImit - Now 分表示.Caption = Minute(myTime) & "分" 秒表示.Caption = Second(myTime) & "秒" Loop msgbox "終了です。" Unload Me End Sub できれば、ボタンを押すとmsgbox"一時停止"を表示させ、表示させている間は、制限時間を一時停止させたいです。制限時間、一時停止ができれば、違うコードでもかまいません。 どうぞよろしくお願いします。

  • VBAのタイマー

    こんにちは VBAで、一日に一回起動するマクロを作ろうと思っています。 Sub timer() Dim settime As Variant Dim waittime As Variant settime = TimeValue("00:35:00") '指定時刻 waittime = TimeValue("00:01:00") settime = settime + waittime '指定時刻待ち時間 Application.OnTime TimeValue(settime), "sub" End Sub な感じなのですが、これだと一度起動すると二日目以降は動作しなくなります。 毎日起動するにはどうしたら良いものでしょうか

  • vba初心者

    いつもお世話様です。 A列にあらかじめデータを入れといてinboxでデータを検索してもしあったらPDFファイルを開いて印刷でもしデータがなかったらinboxに戻るかたちにしたいんですけど、do...loopの使い方が分からないのと、デバックがでてしまってどう直せばいいかわかりません。サンプルコードがあれば助かります。よろしくお願いします。 Dim a As Integer Dim inbox As String Dim Localpath As Variant Dim c As Range, myFadd As String Dim flag As Variant Dim MyShell As Object Dim Mysh As String Dim newHour As Variant Dim newMinute As Variant Dim newSecond As Variant Dim waitTime As Variant Localpath = ThisWorkbook.Path a = 1 inbox = InputBox("番号") Do If inbox = Empty Then Exit Sub End If If inbox = Cells(a, 1) Then MsgBox ("あります") Exit Do Else a = a + 1 ←ここでデバックがでてしまいます。 ElseIf Cells(a, 1) <> inbox Then MsgBox ("ない") End If Loop Set MyShell = CreateObject("WScript.Shell") MyShell.Run ("AcroRd32.exe /n") MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf" newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 10 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Application.SendKeys "{Enter}", True '次の使用例は、10 秒を過ぎるとメッセージを表示します。 If Application.Wait(Now + TimeValue("0:00:10")) Then MsgBox "時間が過ぎました。" End If End Sub

その他の回答 (4)

  • 回答No.5

> Loop While Now() < Finish 今のコードでは、この部分が実行されるときにはFinishに値が入っていません。 なので、すぐにループを抜けてしまうのでしょう。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

そういうことなんですね。まだまだ勉強中の身ですが、精進していきたいと思います。 ご回答ありがとうございました!

  • 回答No.3
  • kkkkkm
  • ベストアンサー率58% (907/1544)

> Ontimeですと、Excelが固まってしまって(午後6時まで動作を中断し続けるので)、他の業務でExcelが使えません。 そうですか、なにかとバッティングするんでしょうか。単純なコードで試してみましたがtを実行したあと普通に使えて再度tが実行されました。 Sub t() Dim i As Long MsgBox "DDD" For i = 1 To 10 Cells(i, "A").Value = i Next Application.OnTime TimeValue("19:30:00"), "t" End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

そうですか。。 こちらでは何か別の要因があるのかもしれません。調べてみます。ご回答ありがとうございました!

  • 回答No.2
  • kkkkkm
  • ベストアンサー率58% (907/1544)

OnTimeメソッドでどうでしょう https://excel-ubara.com/excelvba1/EXCELVBA420.html

共感・感謝の気持ちを伝えよう!

質問者からの補足

Ontimeですと、Excelが固まってしまって(午後6時まで動作を中断し続けるので)、他の業務でExcelが使えません。 使用はしましたが、上記のような都合でDoWhile構文にした次第です。

  • 回答No.1

タイマー割込み https://excel-ubara.com/excelvba4/EXCEL299.html 二重起動防止とか割り込み禁止とか やらないといけないから APIの知識は必須だと思う

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。参考にします。

関連するQ&A

  • ExcelのVBAで、順次動作の実現

    Excelのシートに、トグルボタンを3つ配置します。 ToggleButton1~3 そして、次のマクロを実行すると、2秒ごとに順番にトグルボタンが押されるのかと思いきや、6秒後に一斉にトグルボタンがへっこみます。 どうにか?2秒ごとに順番にトグルボタンが押されるように出来ないでしょうか? Sub test() Dim MyWait As String MyWait = 2 ToggleButton1.Value = True Application.ScreenUpdating = True DoEvents 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton2.Value = True DoEvents Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton3.Value = True Application.ScreenUpdating = True DoEvents End Sub

  • エクセルVBAの値貼り付けについて

    いつもお世話になっております。 エクセルVBAについての質問ですが 以下のコードを使用するとどうしても元の書式の貼り付けになってします。 値(テキスト)貼り付けを実行したいのですがどこのコードをどのように変えればいいか教えてください。 ------------------------------------------------------------------------------------------- Sub IE_Open_Copy() Dim objIE As Object Const OLECMDID_SELECTALL = 17 Const OLECMDID_COPY = 12 Const OLECMDEXECOPT_DODEFAULT = 0 Const URL As String = "https://okwave.jp/question/" Set objIE = CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate URL Do While .Busy DoEvents Loop Do Until .ReadyState = 4 DoEvents Loop .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") .Quit End With AppActivate Application.Caption, True Range("A1").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v" Set objIE = Nothing End Sub ---------------------------------------------------------------------------------------------

  • vba 初心者

    Dim a As Integer Dim inbox As String Dim Localpath As Variant Dim c As Range, myFadd As String Dim flag As Variant Dim MyShell As Object Dim Mysh As String Dim newHour As Variant Dim newMinute As Variant Dim newSecond As Variant Dim waitTime As Variant Localpath = ThisWorkbook.Path a = 1 inbox = InputBox("番号") Do If inbox = Empty Then Exit Sub End If If inbox = Cells(a, 1) Then MsgBox ("あります") Exit Do Else a = a + 1 ElseIf Cells(a, 1) <> inbox Then MsgBox ("ない") End If Loop Set MyShell = CreateObject("WScript.Shell") MyShell.Run ("AcroRd32.exe /n") MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf" newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 10 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Application.SendKeys "{Enter}", True '次の使用例は、10 秒を過ぎるとメッセージを表示します。 If Application.Wait(Now + TimeValue("0:00:10")) Then MsgBox "時間が過ぎました。" End If End Sub ExcelからPDFファイルを検索して印刷したいのですが、 見よう見まねで作ってみたもののエラーが出てしまってよく分かりません。 指摘できるところご指導よろしくお願いします。

  • 指定した時刻になるとセルに色がつくようにしたい

    初心者です。エクセルのVBAで設定した時刻になったらセルに色がつくようにしたいです。 例えば、17:00時にA1セル、18:00にA2セルに色を自動でつくようにしたいと思っています。 OnTimeを使ったらよいと思っていろいろ試しましたが、設定した時刻になってもなにも起こりません。 標準モジュールに以下の内容を記述して、パソコンの時計を変更して確認しています。 できたらクリックしないでファイルオープンしてなにもせずに設定時刻に実行されるようにしたいです。 最初の3秒でB1に現在の時間を取得。 セルA1とA2をクリアしてから設定時間に色をつけるようにしたつもりです。 下記が記述内容です。 Sub 指定時間にマクロを開始() Dim stime As Date Range("A1") = "" Range("A2") = "" Range("B1").Select stime = Now + TimeValue("00:00:03") Application.OnTime TimeValue(stime), "マクロ実行内容", TimeValue("00:05:00") End Sub Sub 時刻の設定1() Application.OnTime EarliestTime:=TimeValue("17:00:00"), Procedure:="Test" End Sub Sub Procedure() Range("A1").Interior.ColorIndex = 8 End Sub Sub 時刻の設定2() Application.OnTime EarliestTime:=TimeValue("18:00:00"), Procedure:="Test" End Sub Sub Procedure2() Range("A2").Interior.ColorIndex = 9 End Sub 実行マクロは有効にしています。 ご教授よろしくお願いします。

  • EXCEL VBAでApplication.waitを使わずに一時停止させたい

    マクロの実行中に、その処理を、条件分岐によってある一定時間だけ止めて、また再開させるようなプログラムを作りたいと考えています。 Application.Waitを使えば、可能というとこまではわかったのですが、それだとマクロ停止中にEXCEL上での一切の操作(たとえばスクロール)ができなくなるので、マクロだけ停止させておいて、他の操作はできるようなやり方はありませんでしょうか? ちなみに、当方の使用OSはXP、EXCELは2007です。VBAは、はじめて取り組む超初心者で、以下のコードもネットやこちらのサイトを探しまくって、ようやくここまでできました。 なお、本マクロで具体的にやりたいことは、楽天証券のRSSというアプリケーションから、EXCELの特定の列に、1行目から順番に、リアルタイムで株価が書き込まれていきます。その株価を監視して、ある一定以上になったら、音で知らせるということをやりたいのです。その際、株価が書き込まれていく間隔は、数秒~数分です。 長々と書きましたが、ご教授いただけると助かります。 <参考:現在のマクロ> Sub Test() Dim waitTime As Variant Dim 繰り返し As Long For 繰り返し = 1 To 10 If Cells(繰り返し, 1).Value >= 10000 Then Shell "mplay32.exe /play /close C:\WINDOWS\Media\notify.wav" ElseIf Cells(繰り返し, 1).Value = Empty Then waitTime = Now + TimeValue("0:00:05") Application.Wait waitTime End If Next 繰り返し End Sub

  • エクセルVBAで、バッチ処理を起動すると・・・

    Windows/XP/pro、エクセル2002 使用です。 c:\autocsvフォルダーに、MS-DOSコマンドを使ってFTPを自動実行しサーバーからCSVを自動的に取得する.TXTファイルと、バッチファイルの.batファイルをおいています。 参考URL http://www.ponko2.com/ftp_bat.html この.batファイルをVBAから呼び出して実行させるように下記のコードを記述ましたが、ファイルは起動するものの、CSVファイルを取得(またはLogin)できません。Openメソッドを使ってもうまくいきませんでした。実行する関数の間違いと思っていますが、それとも、VBAからバッチファイルを実行する場合の何か決まりごと等があるのでしょうか? Sub test() Dim str As Variant str = Shell("c:\autocsv\auto.bat", vbNormalFocus) Application.Wait Now + TimeValue("00:00:10") End Sub (VBAの実行をステップインを使って1行ずつ実行してもファイルを取得できません) なお、.batファイルを単独で起動させた場合は、問題なくcsvファイルの取得はできています。 お手数ですが、ご指導いただけますようお願いします。

  • 指定日時にプログラムを起動させたい。

    指定日時にプログラムを起動させようと考えています。 これを実現するにあたり、Application.OnTime 指定時刻,プログラム とすれば良さそうだと考えました。 ------------------------------------------------------- Application.OnTime DateValue(MyGoDate) + TimeValue(MyGoTime), "一括実行.xls!All_Execute_Click" ------------------------------------------------------- ところが、次の手順で指定日時を作成すると「実行時エラー13型が一致しません」のエラーが出てしまいます。 指定時刻には、必ずバリアント型を指定するとのことで、 「指定時刻 = DateValue("2007/08/31") + TimeValue("07:30:00")」 次の手順で作成されたものが、バリアント型になっていないことが原因かと思います。 ▼質問・お願い 1)「実行時エラー13型が一致しません」のエラーを回避するには、どうしたらよいでしょうか。 2)指定日時にプログラムを起動させるより良いコードがあれば、教えて頂けませんでしょうか。 ▼手順 ------------------------------------------------------- (1)ワークシートのセルに指定日時を入力。 指定日時を入力すると数値になるため、WorksheetFunction.Text((Cells(*, *)), "00")で文字列に変換。 (2)次の変数に指定時刻の要素を格納。 GoYear :Cells(4, 2)に年を入力。 GoMonth:Cells(4, 4)に月を入力。 GoDay :Cells(4, 6)に日を入力。 GoHour :Cells(5, 4)に時を入力。 GoMin :Cells(5, 6)に分を入力。 GoSec  : "00"を固定。 (3)DateValue("2007/08/31")、TimeValue("07:30:00")の( )の中身をつなげる。 MyGoDate = CStr(GoYear & "/" & GoMonth & "/" & GoDay) ▼作成したVBAコード Sub 時刻設定() '指定日時 Dim GoYear As Variant Dim GoMonth As Variant Dim GoDay As Variant Dim GoHour As Variant Dim GoMin As Variant Dim MyGoDate As Variant Dim MyGoTime As Variant Const GoSec As Variant = "00" '秒は固定値。 GoYear = Cells(4, 2) '月 mmに変換。 GoMonth = WorksheetFunction.Text((Cells(4, 4)), "00") '日 ddに変換。 GoDay = WorksheetFunction.Text(Cells(4, 6), "00") '時 hhに変換。 GoHour = WorksheetFunction.Text(Cells(5, 4), "00") '分 mmに変換。 GoMin = WorksheetFunction.Text(Cells(5, 6), "00") MyGoDate = CStr(GoYear & "/" & GoMonth & "/" & GoDay) MyGoTime = CStr(GoHour & "/" & GoMin & "/" & GoSec) Application.OnTime DateValue(MyGoDate) + TimeValue(MyGoTime), "一括実行.xls!All_Execute_Click" End Sub 以上 お手数ですが、よろしくお願い致します。

  • VBAでソースから全てのURLを取得したい

    VBAでソースに書いてある全てのURLを取得したいのですが、現状では一部しか取得できません。 文字数制限にでも引っかかっているのでしょうか? どうすれば全てのURLを取得できるのか・・添削して頂けると or ヒントを教えて頂けると助かります。 よろしくお願いします。 (Excel2003を使用) Sub test() Dim objIE As Object Dim objTAG As Object Dim source As String Dim url As String Dim url_start As String Dim url_end As String Dim y As Long url_end = 1 y = 1 Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = False objIE.Navigate "http://dir.yahoo.co.jp/" Do While objIE.Busy = True DoEvents Loop Application.Wait Time:=Now + TimeValue("00:00:03") source = objIE.Document.All(1).Innerhtml Do While y < 10000 url_start = InStr(url_end, source, "<a href=", vbTextCompare) If url_start = 0 Then y = 10000 Else url_end = InStr(url_start, source, ">", vbTextCompare) url = Mid(source, url_start + 9, url_end - url_start - 10) Cells(y, 1).Value = url y = y + 1 End If Loop End Sub

  • エクセルのVBAについて。

    エクセルのVBAのことは全く分かりませんが、他人の書いたVBAを使わせてもらい、自動で一定の間隔ごとに私が記録したマクロを動すようにしています。 そこで質問なのですが、午前8時00から、午前2時00まで5分おきに動かしたいのですが、日付が変わると動作しなくなってしまいます。どこが悪いのでしょうか? Option Explicit Dim mcolTask As Collection Sub 実行予約() Dim i As Date Dim strProcName As String Dim datBigin As Date Dim datEnd As Date Dim datInterval As Date Dim datTimeout As Date Dim blnJustTime As Boolean ' Setting------------------------------------------------------- datBigin = TimeValue("08:00:00") ' 開始時刻 datEnd = TimeValue("02:00:00") ' 終了時刻 datInterval = TimeValue("00:05:00") ' 実行間隔(少なくとも数秒以上で) datTimeout = TimeValue("00:02:00") ' 実行待機タイムアウト blnJustTime = True ' datInterval で丸めるか strProcName = "MACRO1" ' 実行するマクロ名 '--------------------------------------------------------------- ' 既に実行予約されているか確認 If mcolTask Is Nothing Then ' 日付シリアル値を加算 datBigin = datBigin + Date datEnd = datEnd + Date ' 終了時刻が開始時刻より小さければ日をまたぐので補正 If datEnd < datBigin Then datEnd = datEnd + 1 ' 現在時刻が既に終了時刻を過ぎている場合 If datEnd < Now() Then MsgBox "終了時刻を過ぎているため予約できません。", vbCritical, "終了" Exit Sub End If ' 現在時刻が開始時刻を過ぎていれば補正 If datBigin < Now() Then ' 開始時刻を datInterval で指定された値で丸めるか If blnJustTime Then datBigin = Application.Floor(Now() + datInterval, datInterval) Else datBigin = Now() + datInterval End If End If ' 初期化 Set mcolTask = New Collection ' メイン部分 For i = datBigin To datEnd Step datInterval ' 後から取り消せるようにコレクションに退避 mcolTask.Add CStr(i) & "," & strProcName ' Application.Ontime で実行予約を行う Application.OnTime EarliestTime:=i, _ Procedure:=strProcName, _ LatestTime:=i + datTimeout, _ Schedule:=True Next i Else MsgBox "既に実行中です", vbInformation End If End Sub

  • なぜvbaコードに「#」を付けてもエラーにならないのか?

    なぜvbaコードに「#」を付けてもエラーにならないのか? Sub Sample21() Dim n As Long n = FreeFile Open "D:\Test.txt" For Output As #n Print #n, Now Close #n End Sub というテキストファイルに書き込むマクロですが 「#n」はなぜエラーにならないのですか? 標準モジュールでは、 「#」と書くとコンパイルエラーになるのに For Output As #n だと大丈夫な理由が知りたいです。 あと、気付いた事は 「#」は「&」や「=」と同じ色で表示されます。