他ブックを開きコピーして自ブックへ貼付けるマクロを作成しました。
上記マクロはシート上に配置したボタン(オブジェクト)で実行するようにしています。
【症状】
ボタンからマクロを実行するとExcelが勝手に終了してしまう。
【試したこと】
・原因を探ろうとF8でステップ実行すると正常に終了する。
・F5で実行しても正常に終了する。
・手作業でのコピペでも問題なし。
・シート上のボタンを削除し、作り直してもExcelが勝手に終了してしまう。
【追記】
Workbooks(strFiles).Close False: DoEvents
をコメントアウトしてボタンから実行したところ、正常に終了。
試しに1行上にブレイクポイントを設定して再実行し
strFilesの中身を確認。strFilesにはコピー元として開いた
ファイルのファイル名が入っていました。
開いたファイルが開きっぱなしは困るので、閉じてから処理を終了したいです。
よろしくお願いいたします。
なぜ落ちてしまうのか、落ちないようにするにはどうすれば良いのかを
ご教示いただけると助かります。よろしくお願いします。
Win10、Excel2016、自ブック1,724KB、コピー元他ブック90KB
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Dim sht As Worksheet, rg As Range, strFolder As String, strFiles As String, n As String, errArea As String Sub ③import_pbc() errArea = "" If Application.Range("rng.importflag").Value = "加工済" Then If import_pbc0(errArea) = False Then GoTo errMsg If import_pbc1(errArea) = False Then GoTo errMsg Else If import_pbc0(errArea) = False Then GoTo errMsg End If MsgBox "終わりました(嬉〃∀〃)ゞ": Exit Sub errMsg: MsgBox "【処理エラー】" & vbCrLf & "番号:" & Err.Number & "(Area:" & errNum & ")" & vbCrLf & "メッセージ:" & Err.Description End Sub Function import_pbc0(ByRef errArea As String) As Boolean On Error GoTo errHand Set sht = ThisWorkbook.Sheets("pbc_0") If Application.Range("rng.importflag").Value = "加工済" Then flg = 0: sht.UsedRange.ClearContents If Application.Range("rng.importflag").Value <> "加工済" Then flg = 1 strFolder = Application.Range("rng.folderPBC_0").Value strFiles = Application.Range("rng.filesPBC_0").Value If flg = 0 Then Set rg = sht.Range("A1") If flg = 1 Then Set rg = sht.Cells(Rows.Count, 1).End(xlUp).Offset(2) If func_import(sht, rg, strFolder, strFiles, errArea) = False Then GoTo errHand Sleep 1000: DoEvents import_pbc0 = True: Exit Function errHand: Sleep 1000: DoEvents import_pbc0 = False: If errArea <> "func_import" Then errArea = "import_pbc0" End Function Function import_pbc1(ByRef errArea As String) As Boolean On Error GoTo errHand Set sht = ThisWorkbook.Sheets("pbc_1") strFolder = Application.Range("rng.folderPBC_1").Value strFiles = Application.Range("rng.filesPBC_1").Value Set rg = sht.Range("A1") If func_import(sht, rg, strFolder, strFiles, errArea) = False Then GoTo errHand Sleep 1000: DoEvents import_pbc1 = True: Exit Function errHand: Sleep 1000: DoEvents import_pbc1 = False: If errArea <> "func_import" Then errArea = "import_pbc1" End Function Function func_import(sht, rg, strFolder, strFiles, ByRef errArea As String) As Boolean Call Application制御_False On Error GoTo errHand cnt = WorksheetFunction.Max(sht.Columns(1)) + 1 Workbooks.Open strFolder & strFiles, False With Workbooks(strFiles).Sheets(1) .Cells.EntireColumn.Hidden = False: .Cells.EntireRow.Hidden = False: .UsedRange.AutoFilter .UsedRange.Copy End With rg.PasteSpecial xlPasteFormats: rg.PasteSpecial xlPasteValues: Application.CutCopyMode = False Workbooks(strFiles).Close False: DoEvents With sht If sht.Name <> "pbc_1" Then .Range(rg.Offset(1), .Cells(Rows.Count, 1).End(xlUp)).Value = cnt .Cells.Font.Name = "Meiryo UI": .Cells.Font.Size = 9 End With Set sht = Nothing: DoEvents Call Application制御_True: func_import = True: Exit Function errHand: Call Application制御_True: func_import = False: errArea = "func_import" End Function Sub Application制御_False() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Application.Cursor = xlWait End Sub Sub Application制御_True() Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.Cursor = xlDefault Application.CutCopyMode = False End Sub
「落ちる」ってどうなるのでしょうか。
処理は完了して、エクセルが勝手に終了するのでしょうか?
それとも処理を完了せず、エクセルが終了するのでしょうか?
どちらでしょう?
>「落ちる」ってどうなるのでしょうか。
エクセルが勝手に終了してしまうことです。
わかりづらい表現ですみません。
>どちらでしょう?
開きなおすと実行前に戻ってしまっています。
試しにThisworkbook.Saveを随所に仕込んでみましたが
実行前の状態のままでした。
ということは、完了せずに終了してしまっている...という理解でよさそうな感じがします。
>Workbooks(strFiles).Close False: DoEvents
上記のCloseがきいてるとかではないですか?
質問を編集して状況追記ください。
回答1件
あなたの回答
tips
プレビュー