【VBA】印刷のループを途中で強制的に抜ける方法

質問

Excel2007を使用しています。

「オートフィルター⇒印刷」を繰り返す自動処理のマクロを作成しました。
処理結果自体にはとくに問題はないのですが、印刷量が多いので、何らかの事情がおきた場合ループの途中で強制終了させたいのですが、どうすればいいのでしょうか。

※繰り返し処理は、こちらの仕様をお借りしています。
　http://ameblo.jp/raikayooo/entry-11219911386.html

※印刷したいシートとは別のシートにオートフィルターの条件をA列に入力し、それを上から順番にフィルターをかけて印刷していくものです。

Sub 明細連続印刷()

Dim i As Long
Dim x
Dim MaxRow As Long

'「明細」シートをアクティブにする
ActiveWorkbook.Worksheets("明細").Activate

'オートフィルターが設定されている場合、解除
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If

'「印刷リスト」の記載に従ってオートフィルターを設定
MaxRow = Sheets("印刷リスト").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To MaxRow

x = Sheets("印刷リスト").Cells(i, 1).Value

ActiveSheet.Range("$B$8:$M$20422").AutoFilter Field:=3, Criteria1:=x

'フィルター済みの「明細」シートを印刷
Worksheets("明細").PrintOut

Next i

'オートフィルターが設定されている場合、解除
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If

End Sub

回答No.1

WindFaller

こんにちは。

>印刷量が多いので、何らかの事情がおきた場合ループの途中で強制終了させたいのですが、どうすればいいのでしょうか。

一つは、CommandButton をどこかにおいて、ループの中のFlg がTrueになったら、「止まれ」という信号を出します。

本来、「Cntl + Break」で止まることは止まるのですが、安全に、終わらせるということになると、
もう一つは、Application.EnableCancelKey　の設定をすることです。以前は「Escapeキー」が利いたのですが、今試したら、「Ctrl + Break」のみでした。イレギュラーですから、あまりお勧めしません。

'*加筆したところ
'//
'標準モジュール
Public Flg As Boolean　'*
Sub 明細連続印刷()
　Dim i As Long
　Dim x
　Dim MaxRow As Long
　ActiveWorkbook.Worksheets("明細").Activate

　If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
　End If

　MaxRow = Sheets("印刷リスト").Cells(Rows.Count, 1).End(xlUp).Row
　For i = 1 To MaxRow
　　x = Sheets("印刷リスト").Cells(i, 1).Value
　　ActiveSheet.Range("$B$8:$M$20422").AutoFilter Field:=3, Criteria1:=x
　　DoEvents
　　If Flg = True Then MsgBox "途中終了しました", vbExclamation: Exit For　'*
　　Worksheets("明細").PrintOut
　Next i
　If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
　End If
　Flg = False
End Sub

'シートモジュール(ActiveX コントロールのボタン）
Private Sub CommandButton1_Click()　'*
　Flg = True
End Sub

'//

'//別案（あまりお勧めしはませんが、テクニックとしてあります。
Sub 明細連続印刷()
　Dim i As Long
　Dim x
　Dim MaxRow As Long
　On Error GoTo EndLine　'*
　Application.EnableCancelKey = xlErrorHandler　'Cntl + Break で、止める *

　ActiveWorkbook.Worksheets("明細").Activate

　If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
　End If

　MaxRow = Sheets("印刷リスト").Cells(Rows.Count, 1).End(xlUp).Row
　For i = 1 To MaxRow
　　x = Sheets("印刷リスト").Cells(i, 1).Value
　　ActiveSheet.Range("$B$8:$M$20422").AutoFilter Field:=3, Criteria1:=x
　　DoEvents　'*こちらでは、これは意味がありませんが、念のため
　　Worksheets("明細").PrintOut
　Next i
EndLine:
　If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
　End If
If Err.Number = 18 Then　'*
　MsgBox "途中終了しました。", vbExclamation　'*
End If　'*
　Application.EnableCancelKey = xlInterrupt　'* 標準に戻す
End Sub