みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

Excel VBAの実行中に実行を中断して通常のエクセル作業を入れる方法を教えてください。
1.Application.GetOpenFilenameで選択してワークブックを開く。
2.そのワークブックのシートの中から目的とするシートを選択する。
3.選択したシートを新しいワークブックにコピーする。
4.開いたワークブックを閉じる。
という一連の作業の中で、2.については通常のエクセルの作業のようにシートを一枚ずつ確認して選択する必要があります。
現在、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

投稿日時 - 2008-08-20 11:25:37

QNo.4264475

困ってます

質問者が選んだベストアンサー

こんにちは。

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

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

投稿日時 - 2008-08-20 23:13:20

お礼

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

投稿日時 - 2008-08-21 12:36:13

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

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

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

投稿日時 - 2008-08-20 13:04:14

お礼

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

投稿日時 - 2008-08-21 12:33:32

ANo.1

こんにちは。

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

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

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

確かに、対話型の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

投稿日時 - 2008-08-20 13:00:04

お礼

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

投稿日時 - 2008-08-21 12:29:59

あなたにオススメの質問