実行するとExcelが終了してしまう

Question

他ブックを開きコピーして自ブックへ貼付けるマクロを作成しました。
上記マクロはシート上に配置したボタン(オブジェクト)で実行するようにしています。

【症状】
ボタンからマクロを実行するとExcelが勝手に終了してしまう。

【試したこと】
・原因を探ろうとF8でステップ実行すると正常に終了する。
・F5で実行しても正常に終了する。
・手作業でのコピペでも問題なし。
・シート上のボタンを削除し、作り直してもExcelが勝手に終了してしまう。

【追記】
Workbooks(strFiles).Close False: DoEvents
をコメントアウトしてボタンから実行したところ、正常に終了。
試しに１行上にブレイクポイントを設定して再実行し
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

Comments

[m.ts10806]

「落ちる」ってどうなるのでしょうか。

[nanami12]

処理は完了して、エクセルが勝手に終了するのでしょうか？
それとも処理を完了せず、エクセルが終了するのでしょうか？
どちらでしょう？

[lovelywolf]

>「落ちる」ってどうなるのでしょうか。
エクセルが勝手に終了してしまうことです。
わかりづらい表現ですみません。

>どちらでしょう？
開きなおすと実行前に戻ってしまっています。
試しにThisworkbook.Saveを随所に仕込んでみましたが
実行前の状態のままでした。
ということは、完了せずに終了してしまっている...という理解でよさそうな感じがします。

[m.ts10806]

>Workbooks(strFiles).Close False: DoEvents
上記のCloseがきいてるとかではないですか？

[m.ts10806]

質問を編集して状況追記ください。

Answer 1

Workbooks(strFiles).Close False: DoEvents
を
DoEvents: Workbooks(strFiles).Close False
に入れ替えて実行したところ、問題なく処理を終了できました。

ヒントをいただけてたすかりました。
本当にありがとうございました。