エクセルVBAを中断する場合

Question

簡略化してますが、下記のVBAコードはDATAシートから1行ずつデータをBBBシートに読み込み、プリントまたはプリントプレビューするものです。
予期したとおりに作動するのですが、1点不満があります。
途中でやめることが出来ないのです。もちろんＥｓｃキーを長押しすればエラーになって止まりますが、そうするとステータスバーの表示が残ったままになります。
 On Error GoTo で、Application.StatusBar = ""に飛ぶようにしているのですがＥｓｃキー長押しのエラーでは飛ばないようです。

１．どうやったらすんなり止めることができるでしょうか？
２．その他、改善点がありましたらご指摘ください。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Option Explicit

Sub DM_OutPut()

Dim myYN As Integer, myYN2 As Integer, s As Long, n As Long, x As Long, tx As String
Dim ds As Worksheet, bs As Worksheet, base As Range

s = 300

    myYN = MsgBox("データはDATAシートに切れ目なくセットされてますか？", vbYesNo + vbQuestion, " （＾∇＾）？")
    If myYN = vbNo Then
        Exit Sub
    Else
        myYN2 = MsgBox("本番印刷行きますか？" _
        & vbCrLf & "すぐ行っちゃうなら「はい」を、" _
        & vbCrLf & "テストでプレビュー画面出すなら「いいえ」をクリックしてください。" _
        & vbCrLf & "" _
        & vbCrLf & "プレビューは1画面 約" & Format(s, "#,##0") & "ミリ秒間表示します。", vbYesNo + vbQuestion, " （＾∇＾）？")
    End If
    
    Set ds = Sheets("DATA")
    Set bs = Sheets("BBB")
    Set base = ds.Range("B3") '基準点
        
    bs.Rows(3).ClearContents
    
    Do While 1
    
    On Error GoTo line
    
    If base.Offset(n).Value = "" Then Exit Do '基準点以下にデータのある限り続ける

        bs.Rows(3).Value = base.Offset(n).EntireRow.Value
        
        n = n + 1 'カウント
        
        Application.StatusBar = Format(n, "#,##0") & "件目を処理しました。"

        If myYN2 = vbNo Then
            SendKeys "%C" 'デモ用
            ActiveSheet.PrintPreview
            tx = "プレビュー"
         Else
            ActiveSheet.PrintOut Copies:=1 '本番用
            tx = "プリント指示"
        End If
        
        Sleep s '休みを入れる
        
    Loop

    MsgBox Format(n, "#,##0") & "件を" & tx & "しました。", vbInformation, " (o^-')v "
    
line:

    Application.StatusBar = ""
    
End Sub

pauNed · Accepted Answer

>以下のように使えばいいんですね？
サンプルコードなので、それでいいのでしょうけど、
止めなかった場合のStatusBar表示とMsgBoxが......？
>最後にApplication.EnableCancelKey = xlInterruptで元に戻しました。
終了するとxlInterruptになりますが、明示したほうが良いのでしょうね。
↓ここも参考にしてみてください。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_090_050.html

kobouzu_su · Answer

大雨注意報の中からこんにちは、kobouzuです。＞ESCキーだとエラーで止まります・・・。 ESCキー以外（通常のキー、Ctrlキー、Shiftキーなど）ではエラー（というよりマクロ中断ダイアログ）は出ませんよね。それは、ESCキーがマクロ中断の特別なキーなので＞If GetAsyncKeyState(vbKeySpace) <> 0 Then このように、ESCキー以外でチェックしているときに、ESCキーを押下すると本来のESCキーの機能である「マクロ中断ダイアログ」が出るのです。ですから、今回のようにスペースキーなどのESCキー以外のキーをチェックしているときに、ESCキーが押下されても「本来の中断ダイアログ」を表示させないためには、スペースキーと共に、ESCキーもチェックしなければいけません。 If GetAsyncKeyState(vbKeyEscape) = 0 And _ 　　GetAsyncKeyState(vbKeySpace) <> 0 Then 　　　　MsgBox "Dummy" 　　　　Msg = MsgBox("中断しますか？", vbOKCancel, "確認") 　　　　If Msg = vbOK Then Exit For End If '--------------------------------------- ESCキーのみで中断したければ＞If GetAsyncKeyState(vbKeySpace) <> 0 Then このvbKeySpaceを、vbKeyEscapeに変更して、Msgbox"Dummy"を省くだけです。 ESCキー以外では他のどのキーを押してもエラー（ダイアログ）は出ないし、中断もしません。　　If GetAsyncKeyState(vbKeyEscape) <> 0 Then 　　　　Msg = MsgBox("中断しますか？", vbOKCancel, "確認") 　　　　If Msg = vbOK Then Exit For 　　End If ご存知とは思いますがvbKeySpaceとかvbKeyEscapeなどをキーコード定数とよびます。　　Ctrlキー　　＞　vbKeyControl 　　Shiftキー　　＞　vbKeyShift 詳しくは、キーコード定数をご覧あれ。もちろん通常のCODEを使ってもかまいません。 If GetAsyncKeyState(vbKeyEscape) <> 0 Then If GetAsyncKeyState( 27 ) <> 0 Then 　　ESC　　－＞　２７　　Space　－＞　３２　 -------------------------------------------------- ＞MsgBox "Dummy" ＞これ、わかりません。スペースキーを押しても表示されませんね。これは夏休みの宿題ということで。。(^^;;; 　で、いまのところ先の回答にも書きましたように以下のように覚えおくといいでしょう。通常のキー（あいう、1234、Enterなど）をチェックに使うときは、MsgBox"Dummy"　が、必要。それ以外のキー（ESC、Ctrl、Shiftなど）をチェックに使うときは、MsgBox"Dummy"　は、不要。うーん、相変わらず分かり難い説明なり～。。。(^^;;; 以上です。　

kobouzu_su · Answer

エキスパートさん、こんばんは。

梅雨の晴れ間をぬっての回答です。(^^;;;

お好みのキーで中断するのはどうでせう。例、スペースキー
'--------------------------------------------------------- 
Option Explicit

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub Test()
　Dim K As Long
　Dim Msg As Integer

　For K = 1 To 1000000
　　　Application.StatusBar = K

　　　If GetAsyncKeyState(vbKeySpace) <> 0 Then
　　　　　MsgBox "Dummy"
　　　　　Msg = MsgBox("中断しますか？", vbOKCancel, "確認")
　　　　　If Msg = vbOK Then Exit For
　　　End If

　Next K
　　　Application.StatusBar = ""
End Sub
'-----------------------------------------------------------

これだとお好みのキーで中断できまするよ。
但し、ESCキー（vbKeyEscape）、Ctrlキー（vbKeyControl）等の
通常でないキーを使うときは、MsgBox "Dummy"、は不要です。
これは試してみれば分かります。

以上です。

pauNed · Answer

こんにちは。
EnableCancelKey プロパティについて調べてみましょう。

Sub test()
　　Dim i As Long

　　On Error GoTo erLine
　　Application.EnableCancelKey = xlErrorHandler
　　For i = 1 To 1000000000: Next i
erLine:
　　If Err.Number <> 0 Then MsgBox Err.Number & ":" & Err.Description
End Sub

-Jelly- · Answer

>１．どうやったらすんなり止めることができるでしょうか？

実行中止めたいのなら
Ctrl + Breakでとまります。


End Subの直前に
Application.StatusBar = ""
を入れておいて、
とまったら実行行をそこにもっていって、
F8で追加した１行を実行させて、次の行のEcdSubへ移動すれば良いかと思います。

手作業になりますが。

エクセルVBAを中断する場合

>以下のように使えばいいんですね？

大雨注意報の中からこんにちは、kobouzuです。

エキスパートさん、こんばんは。

この回答への補足

こんにちは。

>１．どうやったらすんなり止めることができるでしょうか？

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング