ママのスキンケアのお悩みにおすすめアイテム

こんにちは。現在エクセルでフォームを使用したVBAマクロを作成中です。
内容はフォーム内のテキストボックスに制限時間を設けて文字入力を行ってもらうものです。

Sub テスト()

do until
 ・
 ・
call timeup
loop

End Sub

Sub timeup()
dim timekp as integer
'テストの開始時間をキープ

'Application.OnTime timekp + TimeValue("1:00:00"),"endform"
'1時間経過後終了を促すフォームを表示する

End Sub

Sub endform()

load userform1
userform1.show
'エクセル終了のコマンドボタンがついているフォームを表示する

End Sub

マクロは大まかに記述しましたが以上のようにすると、一度はマクロの作成が成功したように終了するのですが、ブックを開けたままでいると1時間後に自動的にuserform1が表示されてしまいます。また、ブックを閉じていても自動的にオープンし、(マクロを有効にする)をONにするとデバック状態となります。
変数のtimekpを初期化する事で凌げると思ったのですが、うまくいきません。
以前マクロのヘルプを操作している時にON TIMEメソッドを解除する方法が掲載されていたように思うのですが、探し方がマズイのか見つけられませんでした。
マクロの記述方法がマズイのでしょうか?ON TIMEメソッドを解除しない限り、いつまでもこのメソッドは効力を発揮するのでしょうか?
また、ON TIMEメソッドを解除できるメソッドや良い解決方法がありましたら入門書等を片手にマクロを作成している素人にご教授の程お願い致します。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

>ON TIMEメソッドを解除


OnTimeのヘルプはごらんになられましたか?
expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)

Schedule にfalseを設定することで、直前の実行指定を解除することができます。
具体的には
Application.OnTime timekp + TimeValue("1:00:00"),"endform",,false
とでもすればいいです。
    • good
    • 0
この回答へのお礼

On Timeのヘルプの使用例に説明が記載されていました。
ヘルプはチェックしていたのですが専門用語が多く、省略可と記載されている部分はツイ読み飛ばしてしまうのです。時にはヘルプのヘルプが欲しいくらいです。
今日早速実行したところ成功しました。本当に有難うございました。

お礼日時:2005/08/22 18:24

こんにちは。



do until
 ・
 ・
call timeup
loop

このようにLoopしたら、何度も、行うのではないでしょうか?

expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)

Schedule :=False にするのは、実行前の中途キャンセルのはずですから、今回の場合は、一体、いくつ設定されているのか見当がつきませんが、少なくとも、Loop で、設定しているところを見直さないとダメだと思います。
    • good
    • 0
この回答へのお礼

Loopの設定を見直して、皆さんのおっしゃる通りFalseを設定したものを作成すると成功しました。本当に有難うございました。

お礼日時:2005/08/22 18:35

OnTimeメソッドを使ったことないので自信がありませんが・・・。



OnTimeメソッドの4つ目の引数を「Schedule:=False」にすると、直前のプロシージャの設定を解除するみたいですよ?
    • good
    • 0
この回答へのお礼

自信がないなんて、とんでもない。回答通り実行したところ、うまくいきました。本当に有難うございました。

お礼日時:2005/08/22 18:28

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルで定期的(30分おき)にマクロを実行させる方法は?

エクセルにて刻一刻変る外部データ(株価)を表示させています。それを自動で30分置きにデータ蓄積させる方法はありませんか?

現在は自分で作ったキーボードマクロで 時計を見ながらボタンを押し、データを取り込ん出る始末です。

その簡単マクロに「30分置きに実行させる」と云う記述を付け足す程度で自動実行させる事は可能でしょうか? 
当方キーボードマクロでの自動書き込みしか出来ない素人ですが、少々複雑な物であっても頑張ってみるつもりですので、どなたかご教授下さい。

Aベストアンサー

えーー。。実際に使うなら、zap35 さんのように、OnTime で実行したマクロ
の中で再度 OnTime を登録する方が良いと思います。

この方式だと、OnTime で登録されるのは常に一つだから管理し易いです。
これに未実行の予約を破棄できる仕組みを組み込めばベストだと思います。

今更こんな事言うのは、#6 の大げさなコードを見て、「また、やっちまった...」
と反省しているからです。が、#6 をアップしてしまった以上、それなりに
まとめておきました。こちらは、一括登録方式です。

コードのままだと、午前10時~午後6時まで30分間隔で Macro1 を実行します。
変更点は、

 ・ブッククローズをトラップした
 ・進捗状況をステータスバーに表示するようにした
 ・その他しょうもないこと

です。

このままコピペで使えると思いますが、試される場合は、MACRO1 はご自分の
用途に合わせて適切に修正して下さい。


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("10:00:00")  ' 開始時刻
  datEnd = TimeValue("18:00:00")   ' 終了時刻
  datInterval = TimeValue("00:30: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

Sub 未実行予約強制解除()
 
  Dim i  As Long
  Dim vntS As Variant
 
  On Error Resume Next
  Application.StatusBar = "タスク破棄中... "
  For i = 1 To mcolTask.Count
    vntS = Split(mcolTask.Item(i), ",")
    Application.OnTime CDate(vntS(0)), CStr(vntS(1)), Schedule:=False
  Next i
  Application.StatusBar = ""
  Set mcolTask = Nothing

End Sub

' タスク管理用
Private Sub RemoveTask()
  
  On Error Resume Next
  mcolTask.Remove (1)
  Application.StatusBar = "待機中のタスク... " & mcolTask.Count
  DoEvents
  Beep
  If mcolTask.Count = 0 Then
    Application.StatusBar = ""
    Set mcolTask = Nothing
  End If

End Sub

Sub Auto_Close()

  Dim intRes As Integer
  If Not mcolTask Is Nothing Then
    intRes = MsgBox( _
        Prompt:="待機中のタスクが " & mcolTask.Count & " 件あります。" & vbLf _
           & "破棄して終了しますか?", _
        Buttons:=vbOKCancel + vbDefaultButton2 + vbExclamation, _
        Title:="問い合わせ")
    If intRes = vbOK Then
      Call 未実行予約強制解除
    Else
      ' ブッククローズをキャンセル
      Application.ExecuteExcel4Macro ("Halt(True)")
    End If
  End If

End Sub

' 呼び出すマクロ--> Application.Ontime のマクロ名と一致させて下さい
Sub MACRO1()

  Dim lngRow As Long
  With ThisWorkbook.Sheets("Sheet1")
    lngRow = .Range("V65536").End(xlUp).Offset(1).Row
    .Cells(lngRow, "V").Resize(1, 3).Value = .Range("Q12:S12").Value
    .Cells(lngRow, "Y").Value = Now()
  End With

  ' ご自分のマクロの最後に次の一行を追加しておいて下さい
  Call RemoveTask

End Sub

えーー。。実際に使うなら、zap35 さんのように、OnTime で実行したマクロ
の中で再度 OnTime を登録する方が良いと思います。

この方式だと、OnTime で登録されるのは常に一つだから管理し易いです。
これに未実行の予約を破棄できる仕組みを組み込めばベストだと思います。

今更こんな事言うのは、#6 の大げさなコードを見て、「また、やっちまった...」
と反省しているからです。が、#6 をアップしてしまった以上、それなりに
まとめておきました。こちらは、一括登録方式です。

コードのままだと...続きを読む

QExcel VBAで「プログラム実行」ボタンと「プログラム停止」ボタンをつけたい

ExcelでVBAを使いアプリをつくっています。
プログラムを実行させるボタンはもちろんつくれるのですが、
プログラムを停止させるボタンをつくるにはどうしたら良いのかと悩んでいます。

ボタンに登録できるのはひとつのプロシージャですよね。
とすると「他のプロシージャを止める」プロシージャをつくらねばならないのでしょうか。とするとどうやって・・・?

Aベストアンサー

s_husky です。

状況が判明したので再回答!

Public StopNow As Boolean

Public Sub Test()
  Do Until StopNow
    Sheets(1).Cells(1, 1) = Sheets(1).Cells(1, 1) + 1
    Pause 10
  Loop
  If StopNow Then
    MsgBox "Test の実行をストップしました。"
  End If
End Sub

Public Sub Pause(ByVal PauseTime As Single)
  Dim Finish As Single
  
  Finish = Timer + PauseTime
  Do
    DoEvents
  Loop Until Timer > Finish
End Sub

Private Sub CommandButton2_Click()
  StopNow = True
End Sub

Private Sub CommandButton1_Click()
  Test
End Sub

起動したプロシージャを止める必要があるということはループ処理と理解。
ならば、ループの条件を操作すれば宜しいかと。
CommandButton1 で起動した Test は CommandButton1 で止めれます。

Application.OnTime TimeValue("16:30:00"), "Test"

で起動しようと同じ理屈。

Application.OnTime は、一種の起動ツール。
当然に停止機能もあるが、停止を制御するには上記のような仕掛けが必要と思います。

s_husky です。

状況が判明したので再回答!

Public StopNow As Boolean

Public Sub Test()
  Do Until StopNow
    Sheets(1).Cells(1, 1) = Sheets(1).Cells(1, 1) + 1
    Pause 10
  Loop
  If StopNow Then
    MsgBox "Test の実行をストップしました。"
  End If
End Sub

Public Sub Pause(ByVal PauseTime As Single)
  Dim Finish As Single
  
  Finish = Timer + PauseTime
  Do
    DoEvents
  Loop Until Timer > Finish
End Sub

P...続きを読む

QOnTime 使用時のプロシージャへの引数の与え方、その記述方法を教えて下さい。

初心者ですが、宜しくお願いします。

Application.OnTime EarliestTime:=TimeValue(time_ptn), Procedure:="my_func"

上記コードの、末尾のプロシージャの指定において、

Dim prm1 As String, prm2 As Long

Function my_func(prm1,prm2)
   ~内容~
End Function

または、

Sub my_func(prm1,prm2)
   ~内容~
End Sub

というプロシージャを指定したいのですが、
末尾の書き方が分からず困っております。

「Procedure:="my_func(prm1,prm2)"」
「Procedure:= my_func(prm1,prm2)」

のようにやっても、うまくいきません。
正しい書き方をどなたか教えて下さい。

Aベストアンサー

Option Explicit

Sub test()
  Dim s As String
  Dim i As Long
  Dim j As Long
  Dim x As String
  
  s = "a"
  i = 1
  j = 2
  '文字列 & 変数 & 文字列...みたいに繋ぎます。
  MsgBox "'my_func """ & s & """," & i & "," & j & "'"
  Application.OnTime EarliestTime:=Now + TimeValue("0:00:01"), _
            Procedure:="'my_func """ & s & """," & i & "," & j & "'"
  '
  'x = "'my_func """ & s & """," & i & "," & j & "'"
  'MsgBox x
  'Application.OnTime EarliestTime:=Now + TimeValue("0:00:01"), _
            Procedure:=x
  
End Sub

Sub my_func(prm1 As String, prm2 As Long, prm3 As Long)
  MsgBox prm1 & prm2 & prm3
End Sub

Option Explicit

Sub test()
  Dim s As String
  Dim i As Long
  Dim j As Long
  Dim x As String
  
  s = "a"
  i = 1
  j = 2
  '文字列 & 変数 & 文字列...みたいに繋ぎます。
  MsgBox "'my_func """ & s & """," & i & "," & j & "'"
  Application.OnTime EarliestTime:=Now + TimeValue("0:00:01"), _
            Procedure:="'my_func """ & s & """," & i & "," & j & "'"
  '
  'x = "'my_func """ & s & """," & i & "," & j & "'"
  '...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q【Excel VBA】マクロでExcel自体を終了させたい

環境:WindowsXP、Excel2003

マクロでエクセルを終了(ブックを閉じて、アプリケーション自体も終了)させたいのですが、以下のコードではアプリケーションが閉じてくれません。

ThisWorkbook.Close
ExcObj.Quit
Application.Quit

どこか悪いところはありますでしょうか?

よろしくお願いします。

Aベストアンサー

普通に考えれば質問者のコードで上手くいきそうですが
hana-hana3さんの回答にもあるようにThisWorkBook.Closeでコード終了となりますので
Application.QuitをThisWorkBook.Closeの前にもってこないといけません。
Application.Quitはそれがあるプロシージャのコードが全て終わるまで
その実行を保留するちょと特別動作をします。

'-------------------------------------
 Application.Quit
 ThisWorkbook.Close
'-------------------------------------
 
 

QDoEvents関数って何?

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そこで「EXCEL VBA パーフェクトマスター」という本を見たら

for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
DoEvents
next i
unload userform1
と入力すれば解決することがわかりました。

しかし「DoEvents」についてあまり詳しく書いていなかったのでDoEvents関数をヘルプで見ると、
「発生したイベントがオペレーティング システムによって処理されるように、プログラムで占有していた制御をオペレーティング システムに渡すフロー制御関数です。」

と書いてあるのですが正直、書いてあることがよくわかりません。

どなたかDoEvents関数について、
もう少しわかりやすく教えていただけませんか。
それから、最初に書いたコードで実行すると
ユーザーフォームの背景が真っ白になってしまう原因も
教えていただけませんか?

よろしくお願いいたします。

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そ...続きを読む

Aベストアンサー

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
    DoEvents
    Cells(i,1) = ""
  Next i
End Sub

Private Sub CommandButton2_Click()
  MsgBox "hoge"
End Sub

っていうフォームのコードがあった場合、
DoEvents を入れることによって、ループ中にユーザーがCommandButton2 を押すことによって CommandButton2 のクリック イベントも動いちゃいます。
CommandButton1 のクリック イベントではループの前に
CommandButton1.Enabled = False
CommandButton2.Enabled = False
を書いてフォーム上の CommandButton を無効にしておき、ループが終わったら
CommandButton1.Enabled = True
CommandButton2.Enabled = True
と書いて CommandButton を有効に戻してください。

これを工夫すれば、CommandButton2 で CommandButton1 のループを途中キャンセルする処理もすることができます。

Private Canceled As Boolean

Private Sub CommandButton1_Click()

  CommandButton2.Enabled = False

  Dim i As Long
  For i = 1 To 50000
    DoEvents

    If Canceled = True Then
      MsgBox "キャンセルしました"
      Exit Sub
    End If

    Cells(i, 1).Value = ""
  Next i
End Sub

Private CommandButton2_Click()
  Canceled = True
End Sub



コードの行頭にあるスペースは見易さのために全角スペースで作成していますので、これをこのままコピペするとエラーになるかもしれません。
コピペするなら行頭の全角スペースを半角スペースに直してください。

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
...続きを読む

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

Qエクセルでブックを閉じたときマクロを終了させるには

現在、以下のようなマクロを組んでいます。

---------------------------------------
Dim 利用制限時間 As Integer

Private Sub Workbook_Open()

If Not ThisWorkbook.ReadOnly Then
利用制限時間 = 10 '分 + 起動時刻:Now
警告時刻 = Now + 10 * TimeValue("00:01:00") '分に変換
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
End If

End Sub

Private Sub 利用制限ご注意()
警告文 = "共有ファイルを開いて" + CStr(利用制限時間) + "分経過しました。" + vbCrLf
警告文 = 警告文 + "使用しない場合は終了してください。"
MsgBox 警告文, vbCritical, "共有ファイルの利用について"

Workbooks("共有ファイル.xls").Close

End Sub

---------------------------------------

しかし、10分たたずにブックのみ終了し、エクセルのみの起動をしていても10分後には、「共有ファイルを開いて10分経過しました」と出てきます。
エクセルを終了させればよいのでしょうが、ブックを終了させただけでマクロも同時に終了できないでしょうか?

現在、以下のようなマクロを組んでいます。

---------------------------------------
Dim 利用制限時間 As Integer

Private Sub Workbook_Open()

If Not ThisWorkbook.ReadOnly Then
利用制限時間 = 10 '分 + 起動時刻:Now
警告時刻 = Now + 10 * TimeValue("00:01:00") '分に変換
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
End If

End Sub

Private Sub 利用制限ご注意()
警告文 = "共有ファイルを開いて" + CStr(利用制限時間) + "分経過しました。" + vbCrLf
警告文 ...続きを読む

Aベストアンサー

こんにちわ。

#7の回答では時間が無くて良く見れなかったのですが、気づいた点を1つ。
警告分では「使用しない場合は終了してください。」と出力しているのですから、
利用継続の有無を確認するべきだと思います。

それらを踏まえてサンプルを乗せます。
そろそろ完成出来るといいですね。

Private 開始時刻 As Date
Private 警告時刻 As Date
'利用制限時間については定数で宣言するよりも、
'設定専用シートを用意し読み込むか、
'又はIniファイルなどから読み込むようにすると
'汎用性を持たせることが出来るでしょう。
Private Const 利用制限時間 As Integer = 10 '分

Private Sub Workbook_Open()
開始時刻 = Now
Call SetOnTime
End Sub

Private Sub 利用制限ご注意()
Dim 警告文 As String
警告文 = vbNullString
警告文 = 警告文 & ThisWorkbook.Name & "を開いて" & CStr(DateDiff("n", 開始時刻, 警告時刻)) & "分経過しました。" & vbCrLf
警告文 = 警告文 & "使用しない場合は終了してください。" & vbCrLf
警告文 = 警告文 & "継続して使用しますか?"
If MsgBox(警告文, vbYesNo Or vbExclamation, "共有ファイルの利用について") = vbYes Then
Call SetOnTime
Exit Sub
End If
ThisWorkbook.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Now < 警告時刻 Then Call ResetOntime
If ThisWorkbook.Saved = False Then
If MsgBox("'" & ThisWorkbook.Name & "'への変更を保存しますか?", _
vbYesNo Or vbExclamation, "Microsoft Excel") = vbOK Then
ThisWorkbook.Save
Else
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
End If
End Sub

Private Sub SetOnTime()
If Not ThisWorkbook.ReadOnly Then
警告時刻 = DateAdd("n", 利用制限時間, Now) '現在時刻+利用制限時間
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
End If
End Sub

Private Sub ResetOntime()
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意", Schedule:=False
End Sub

Wendy02さんへ。
もしお気を悪くされていたらごめんなさい。
好みの問題もありますから、人それぞれで良いと思います。
出すぎた真似をしてすみませんでした。

こんにちわ。

#7の回答では時間が無くて良く見れなかったのですが、気づいた点を1つ。
警告分では「使用しない場合は終了してください。」と出力しているのですから、
利用継続の有無を確認するべきだと思います。

それらを踏まえてサンプルを乗せます。
そろそろ完成出来るといいですね。

Private 開始時刻 As Date
Private 警告時刻 As Date
'利用制限時間については定数で宣言するよりも、
'設定専用シートを用意し読み込むか、
'又はIniファイルなどから読み込むようにすると
'汎用性を持た...続きを読む

QApplication.OnTimeで引数付き関数を呼び出したい

Application.OnTimeで引数付き関数を呼び出したいのですが、可能でしょうか?
例を挙げると、

  Sub Procedure1 (index as integer)
      MsgBox index
  End Sub

を、呼び出してみたいです。
詳しい方、よろしくお願いいたします。

Aベストアンサー

こんなのはどうでしょうか?
Application.OnTime Now + TimeValue("00:00:02"), "'Procedure1(100)'"
Application.OnTime Now + TimeValue("00:00:03"), "'Procedure1(200)'"


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング