Excel VBAの実行中に実行を中断して通常のエクセル作業を入れたい。

質問

Excel VBAの実行中に実行を中断して通常のエクセル作業を入れる方法を教えてください。
１．Application.GetOpenFilenameで選択してワークブックを開く。
２．そのワークブックのシートの中から目的とするシートを選択する。
３．選択したシートを新しいワークブックにコピーする。
４．開いたワークブックを閉じる。
という一連の作業の中で、２．については通常のエクセルの作業のようにシートを一枚ずつ確認して選択する必要があります。
現在、stopを使って強引に中断させているのですが、何か良い方法はありますでしょうか？
よろしくお願いします。
ちなみに、今、私が作っているのプロシージャーは下記のようなものです。
Private QUOTfile As String
Private filename As String

Sub QUOTfileOpen()
QUOTfile = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
If QUOTfile <> "False" Then
Workbooks.Open QUOTfile
End If
filename = ActiveWorkbook.Name
Stop
ActiveSheet.Copy

With Application
.Dialogs(xlDialogSaveWorkbook).Show
End With

Workbooks(filename).Close saveChanges:=False

End Sub

回答No.3

KenKen_SP · ベストアンサー

こんにちは。

キャプチャーツールなんかで良く見かけるイメージで。待機時間の
カウントダウンをステータスバーに表示させてます。

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub Sample()

　　Const INTERVAL As Long = 10000 ' // 単位ミリ秒-10秒間

　　Dim vFilename　As Variant
　　Dim wb　　　　 As Workbook
　　Dim lTimeout　 As Long
　　Dim lRefresh　 As Long
　　Dim iRes　　　 As Integer
　　Dim fContinue　As Boolean

　　vFilename = Application.GetOpenFilename( _
　　　　　　　　FileFilter:="Microsoft Excelブック(*.xls),*.xls", _
　　　　　　　　Title:="ブックを開いた後に目的のシートを" & _
　　　　　　　　　　　 CStr(Int(INTERVAL / 1000)) & "秒以内で選択")
　　If VarType(vFilename) = vbBoolean Then
　　　　Exit Sub
　　End If
　　Set wb = Workbooks.Open(filename:=vFilename)

　　fContinue = False
　　Do While Not fContinue
　　　　Application.StatusBar = "Waiting..." & CStr(Int(INTERVAL / 1000)) & "sec"
　　　　lTimeout = timeGetTime() + INTERVAL
　　　　lRefresh = timeGetTime()
　　　　While lTimeout > timeGetTime()
　　　　　　' // ステータスバー更新間隔 0.2秒（チラつかない程度で適当）
　　　　　　If timeGetTime() - lRefresh >= 200 Then
　　　　　　　　Application.StatusBar = "Waiting..." & _
　　　　　　　　　　　　　　　　　　　　CStr(Int((lTimeout - timeGetTime()) / 1000) + 1) & _
　　　　　　　　　　　　　　　　　　　　"sec"
　　　　　　　　lRefresh = timeGetTime()
　　　　　　End If
　　　　　　DoEvents
　　　　Wend
　　　　Application.StatusBar = "Waiting...0sec"
　　　　iRes = MsgBox("[は　い]　　 　次の処理を続行します" & vbLf & _
　　　　　　　　　　　"[いいえ]　　 　シートを選択し直します" & vbLf & _
　　　　　　　　　　　"[キャンセル] 処理中止", _
　　　　　　　　　　　vbYesNoCancel Or vbDefaultButton2 Or vbInformation, _
　　　　　　　　　　　"選択できましたか？")
　　　　Select Case iRes
　　　　　　Case vbYes:　　 fContinue = True: Exit Do
　　　　　　Case vbCancel:　Exit Do
　　　　End Select
　　Loop

　　Application.StatusBar = ""
　　If fContinue Then
　　　　wb.Windows(1).SelectedSheets.Copy
　　　　Application.Dialogs(xlDialogSaveWorkbook).Show
　　End If

　　wb.Close SaveChanges:=False
　　Set wb = Nothing

End Sub

お礼

ありがとうございました。
コピペして思ったように処理できました。
これと似たケースで途中でexcel作業を入れたいものが幾つかありましたので、それにも応用できるので大変助かりました。

回答No.2

fujillin

一定時間経過後に続行でよければOnTimeメソッドなどでも可能ですが、作業の性格からそのような設定ではうまくいかないと推測されます。
現状で、マクロの実行のきっかけをどのようにしているのか不明ですが（ボタン登録やコマンド登録かな？）、続行する際に、多分、続行の指示をしていますよね？
ということはマクロの実行を指示するのと同じなので、一番簡単なのは前半と後半のルーチンを分割しておいて、マクロを呼び出せば良いのでは？（無理に一つのサブルーチンにする必要がないと思われます）
例えばボタン登録を利用する場合を例にすれば、前半の実行ボタンと後半の実行ボタンを用意しておいて、それぞれのマクロを登録しておく。

どうしても一つのマクロにしたければ（その理由は不明ですが）、マクロを呼び出すごとに前半と後半を交互に実行するようなサブルーチンにしておくことでしょうか。（実際にはこちらの方が使いにくいと思います。誤操作も起き易いでしょうし。）
＜交互に実行する構造のサンプル＞
Sub test()
Static flag As Boolean
　flag = Not flag
　If flag Then
　　'First　　--前半の処理を記載（又はSub呼び出し）
　Else
　　'Second　--後半の処理を記載（又はSub呼び出し）
　End If
End Sub

お礼

ありがとうございました。

回答No.1

Wendy02

こんにちは。

>filename = ActiveWorkbook.Name
>Stop
>ActiveSheet.Copy

その、インターラプトはまずいですね。

>２．については通常のエクセルの作業のようにシートを一枚ずつ確認して選択する必要があります。

確かに、対話型のInputBox メソッドでは思ったようにはいきませんので、
UserForm のモードのShowModal を、False (または、起動で、UserForm.Show 0 とする）
として、

'標準モジュール
'---------------------------------

Public filename As String

Sub QUOTfileOpen()
Dim QUOTfile As String
　　QUOTfile = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
　　If StrComp(QUOTfile, "False", 1) <> 0 Then
　　　　Workbooks.Open QUOTfile
　　Else
　　　　Exit Sub
　　End If
　　filename = ActiveWorkbook.Name
　　UserForm1.Show 0

End Sub

'UserForm
'UserForm モジュール
'---------------------------------

Private Sub CommandButton1_Click()
Dim s As Variant
　'シートの複数選択が可能
　For Each s In ActiveWindow.SelectedSheets
　 s.Copy
　 With Application
　　 .Dialogs(xlDialogSaveWorkbook).Show
　　 ActiveWorkbook.Close False
　 End With
　Next
　Workbooks(filename).Close False
　Unload Me
End Sub
Private Sub UserForm_Initialize()
　Workbooks(filename).Activate
End Sub

お礼

ありがとうございました。
Userformはこれまで使った事が無いので勉強になりました。今後userformも使ってみようと思います。