![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
簡略化してますが、下記のVBAコードはDATAシートから1行ずつデータをBBBシートに読み込み、プリントまたはプリントプレビューするものです。
予期したとおりに作動するのですが、1点不満があります。
途中でやめることが出来ないのです。もちろんEscキーを長押しすればエラーになって止まりますが、そうするとステータスバーの表示が残ったままになります。
On Error GoTo で、Application.StatusBar = ""に飛ぶようにしているのですがEscキー長押しのエラーでは飛ばないようです。
1.どうやったらすんなり止めることができるでしょうか?
2.その他、改善点がありましたらご指摘ください。
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
No.3ベストアンサー
- 回答日時:
>以下のように使えばいいんですね?
サンプルコードなので、それでいいのでしょうけど、
止めなかった場合のStatusBar表示とMsgBoxが......?
>最後にApplication.EnableCancelKey = xlInterruptで元に戻しました。
終了するとxlInterruptになりますが、明示したほうが良いのでしょうね。
↓ここも参考にしてみてください。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …
とても参考になりました。
有難うございます。
Sub test2()
Dim i As Long
Dim swEND As Boolean
On Error GoTo erLine
Application.EnableCancelKey = xlErrorHandler
For i = 1 To 10000
Application.StatusBar = i
Cells(i, 1) = i
If swEND = True Then
If MsgBox("中断キーが押されました。" & vbCr & _
"終了しますか?", vbYesNo) = vbYes Then
Exit For
Else
swEND = False
End If
End If
Next i
erLine:
If Err.Number = 18 Then
swEND = True
Resume
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & ":" & Err.Description
End If
Application.EnableCancelKey = xlInterrupt
Application.StatusBar = ""
End Sub
としてみました。
No.5
- 回答日時:
大雨注意報の中からこんにちは、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 -> 27
Space -> 32
--------------------------------------------------
>MsgBox "Dummy"
>これ、わかりません。スペースキーを押しても表示されませんね。
これは夏休みの宿題ということで。。(^^;;;
で、いまのところ先の回答にも書きましたように以下のように覚えおくといいでしょう。
通常のキー(あいう、1234、Enterなど)をチェックに使うときは、MsgBox"Dummy" が、必要。
それ以外のキー(ESC、Ctrl、Shiftなど)をチェックに使うときは、MsgBox"Dummy" は、不要。
うーん、相変わらず分かり難い説明なり~。。。(^^;;;
以上です。
大雨の中、有難うございます。
九州の方は随分ひどいようですね。大丈夫ですか?
> ご存知とは思いますがvbKeySpaceとかvbKeyEscapeなどをキーコード定数とよびます。
知りませんでした。勉強になります。
有難うございました。
No.4
- 回答日時:
エキスパートさん、こんばんは。
梅雨の晴れ間をぬっての回答です。(^^;;;
お好みのキーで中断するのはどうでせう。例、スペースキー
'---------------------------------------------------------
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"、は不要です。
これは試してみれば分かります。
以上です。
この回答への補足
一応こんな感じで出来ました。
間違ってないですよね?
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
Dim swEND As Boolean
s = 300
swEND = False
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
On Error GoTo erLine
Application.EnableCancelKey = xlErrorHandler
Do While base.Offset(n).Value <> "" '基準点以下にデータのある限り続ける
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 '休みを入れる
If swEND = True Then
If MsgBox("中断キーが押されました。" & vbCr & _
"終了しますか?", vbYesNo + vbQuestion, " (^∇^)?") = vbYes Then
Exit Do
Else
swEND = False
End If
End If
Loop
erLine:
If Err.Number = 18 Then
swEND = True
Resume
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & ":" & Err.Description
End If
If swEND = False Then
MsgBox Format(n, "#,##0") & "件を" & tx & "しました。", vbInformation, " (o^-')v "
End If
Application.EnableCancelKey = xlInterrupt
Application.StatusBar = ""
End Sub
おや、大師様、いつもありがとうございます。
スペースキーなどでも中断可能なんですね、知りませんでした。
今回はESCきーかCtrl+Breakで処理しようと思いますが、質問のエキスパート?としましては勉強になることばかりです。
> MsgBox "Dummy"
これ、わかりません。スペースキーを押しても表示されませんね。
ESCキーだとエラーで止まります・・・。
わかりませぬぅ・・・。
No.2
- 回答日時:
こんにちは。
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
pauNedさま、有難うございます。
EnableCancelKey ですか、また新しい呪文をひとつ覚えました。
以下のように使えばいいんですね?
Ctrl+BreakやEscキーで止めた場合は、StatusBarをクリアします。
最後にApplication.EnableCancelKey = xlInterruptで元に戻しました。
Sub test2()
Dim i As Long
On Error GoTo erLine
Application.EnableCancelKey = xlErrorHandler
For i = 1 To 1000000000
Application.StatusBar = i
Next i
erLine:
If Err.Number = 18 Then
MsgBox "中止します。"
Application.StatusBar = ""
Else
MsgBox Err.Number & ":" & Err.Description
End If
Application.EnableCancelKey = xlInterrupt
End Sub
No.1
- 回答日時:
>1.どうやったらすんなり止めることができるでしょうか?
実行中止めたいのなら
Ctrl + Breakでとまります。
End Subの直前に
Application.StatusBar = ""
を入れておいて、
とまったら実行行をそこにもっていって、
F8で追加した1行を実行させて、次の行のEcdSubへ移動すれば良いかと思います。
手作業になりますが。
さっそく有難うございます。
ただ、
> End Subの直前に
> Application.StatusBar = ""
> を入れておいて、
質問で書いたとおり、それはもうすでに入っています。
> 手作業になりますが。
すみません、VBAの質問をしています。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・「I love you」 をかっこよく翻訳してみてください
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・昔のあなたへのアドバイス
- ・かっこよく答えてください!!
- ・あなたが好きな本屋さんを教えてください
- ・スタッフと宿泊客が全員斜め上を行くホテルのレビュー
- ・【大喜利】【投稿~8/27】 こんなガソリンスタンド二度と来るか!なぜそう思った?
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・【お題】動物のキャッチフレーズ
- ・【お題】甲子園での思い出の残し方
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・「それ、メッセージ花火でわざわざ伝えること?」
- ・自分用のお土産
- ・人生で一番お金がなかったとき
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・ちょっと先の未来クイズ第1問
- ・ゴリラ向け動画サイト「ウホウホ動画」にありがちなこと
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
プラス(足す)キーはどうやっ...
-
「か」を数字で表すとどうなり...
-
PgDn、PgUpの設定が急に変わっ...
-
Scroll Lockが勝手に有効になる...
-
キーボードがCtrlキーが押され...
-
「(アクサングラーブ)キー」と...
-
パソコンの青い線枠が消えませ...
-
Ctrlキー+HomeキーでセルA1へ移...
-
Shiftキーのはめ方を教えてくだ...
-
メールアドレスの作成の際上バ...
-
矢印キーのロック解除方法
-
Shiftキーの解除方法
-
IMEパッドがショートカットキー...
-
(word) 文字列の上に線を引く方法
-
プーリーのキーが外れない
-
Wordで繰り返しのショートカッ...
-
キーボードにゴミ・・・取り方は?
-
画面表示できない場合のセーブ...
-
ペンタブの製品登録は必要か
-
エクセルVBAを中断する場合
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
プラス(足す)キーはどうやっ...
-
キーボードがCtrlキーが押され...
-
「か」を数字で表すとどうなり...
-
Scroll Lockが勝手に有効になる...
-
メールアドレスの作成の際上バ...
-
「(アクサングラーブ)キー」と...
-
パソコンの青い線枠が消えませ...
-
IMEパッドがショートカットキー...
-
PgDn、PgUpの設定が急に変わっ...
-
プーリーのキーが外れない
-
Ctrlキー+HomeキーでセルA1へ移...
-
あさぎーにょちゃんの『別の人...
-
VSCodeで上書きモードにならない
-
PDF-XChange Viewer 全画面表示...
-
BackSpaceキーを押しても・・・...
-
パソコンをネットに繋いでいな...
-
矢印キーのロック解除方法
-
Excelでカーソルの移動が...
-
キーボードの上部にあるランプ...
-
Access2010 Enterで次テキスト...
おすすめ情報