実行時エラーの対処方法

実行時エラーの処理は行ラベルを作成して「On Errorステートメント」を記述しておきます。
実行時エラーとは．．．．   プログラム(マクロ)を作成して、テストを行なって正しく動くことも検証されているのに、 本番運用側で実行させたところエラーになったというようなことがあります。
実際にいろいろな環境で運用されるプログラム(マクロ)は、ある程度これらのエラーに対する対処が必要であり、 このページはそのための説明になります。



 この「実行時エラー」は主にプログラム(マクロ)の外とデータのやりとりを行なう時に発生するもので、 以下のような例になります。
  ・データベースや外部ファイルとのやりとりでの想定外データによるもの
  ・ネットワーク障害やファイル書き出しの空き領域無しなどの環境不整合
  ・ワークシートとのやりとりでも例えば日付セルに日付でないものが入っていたなどの不整合
  ・ユーザーが行列の追加・削除を行なってしまったことでのズレによる不整合
  ・プリンタでの印刷不成功
  ・実行PCの変更により必須だった外部ライブラリが参照できなくなった等の環境不整合



 これらは一般にプログラム(マクロ)側でデータ修復して処理を続行することができないものであり、 運用者にエラーの発生や事象内容を通知して処理を打ち切るものです。
(最後の実行PC問題はコンパイルエラーになる場合もあります)

このエラー処置を行なわない場合の実行時エラーの現象はこのようになります。
型が一致しません。
これは「Integer型(整数型)」の変数に「a」を転記した時に起こります。数字項目にアルファベットを入力するのですから当然エラーになります。ここで「デバッグ」をクリックすると、
エラー処理を行なわない例
(この画像をクリックすると、このページのサンプルがダウンロードができます。)
このようにソースプログラム上のエラー発生箇所が黄色に表示されます。

エラーの表記をコントロールする場合はこのようにします。

独自にエラー処理している場合は、「デバッグ」ボタンは表示されません。このように何のデータでエラーになったのかなどを合わせて表示させることができます。

'***************************************************************************************************
'* 処理名　：TEST2
'* 機能　　：テスト②
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：エラー表記を独自にコントロールする例
'* 注意事項：
'***************************************************************************************************
Sub TEST2()
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "TEST2"
    Dim vrnINPUT As Variant                                         ' 入力値WORK
    Dim intNUM As Integer                                           ' 転記先変数(整数)
    Dim strMSG As String                                            ' メッセージWORK

    vrnINPUT = "a"                                          ' 入力データ
    On Error GoTo TEST2_ERR
    intNUM = vrnINPUT                                       ' 整数型変数に転記(エラー発生)
    GoTo TEST2_EXIT

'===================================================================================================
' エラー時の飛び先(行ラベル)
TEST2_ERR:
    ' エラーメッセージを編集
    strMSG = "実行時エラー:" & Err.Number & " " & Err.Description & vbCr & _
             "入力データは「" & vrnINPUT & "｣です。"
    ' エラーメッセージを表示
    MsgBox strMSG, vbCritical, cnsTitle

'===================================================================================================
' 終了
TEST2_EXIT:
    On Error GoTo 0
End Sub
「On Error GoTo ．．．」を書くことでエラー処理が有効となります。逆にエラー処理を無効に戻す場合は、「On Error GoTo 0」と書きます。
エラー処理の飛び先行ラベル「ERR1」は、正常時には動作させないように直前に「Exit Sub」を記述しています。これによりエラーにならない場合は「ERR1」から下の処理は行なわれません。
基本的には「On Error GoTo ．．．」はそのプロシージャ内のみ有効です。各プロシージャで記述します。
(上位、下位が明確な関係の場合、上位プロシージャで下位プロシージャ分をまとめてエラー処理することは可能です：後述)
ちなみに、メッセージ(MsgBox)では、アイコンやタイトルも変更できます。このサンプルの「vbExclamation」だと「注意」の黄色アイコン、「vbCritical」だと「停止」の赤いアイコン、「vbInformation」だと「案内」アイコンとなります。

※ただし、このようなエラー処理は「正常な動作の確認」が取れてから実装するようにして下さい。 最初に説明したように、処理記述のみであれば実行時エラー発生時は「デバッグ」ボタンで発生箇所が黄色で表示されるようになりますが、 このエラー処理を組み込むとエラー処理に流れてしまうため、エラー箇所の特定ができなくなります。

エラー発生時に判断の上、別な値に置き換えて進める場合はこのようにします。

「ゼロに置き換えますか？」で「はい」を選択すると、問題の「a」は「0」に置き換えられて正常終了します。

'***************************************************************************************************
'* 処理名　：TEST3
'* 機能　　：テスト③
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：エラー表記を独自にコントロールする例②
'* 注意事項：
'***************************************************************************************************
Sub TEST3()
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "TEST3"
    Dim vrnINPUT As Variant                                         ' 入力値WORK
    Dim intNUM As Integer                                           ' 転記先変数(整数)
    Dim strMSG As String                                            ' メッセージWORK

    vrnINPUT = "a"                                          ' 入力データ
    On Error GoTo TEST3_ERR
    intNUM = vrnINPUT                                       ' 整数型変数に転記(エラー発生)
    ' 処理結果表示
    strMSG = "結果は" & intNUM & "で正常終了しました。"
    MsgBox strMSG, vbInformation, cnsTitle
    GoTo TEST3_EXIT

'===================================================================================================
' エラー時の飛び先(行ラベル)
TEST3_ERR:
    ' エラーメッセージを編集
    strMSG = "実行時エラー:" & Err.Number & " " & Err.Description & vbCr & _
             "入力データは「" & vrnINPUT & "｣です。ゼロに置き換えますか？"
    ' エラーメッセージを表示(確認入力を求める)
    If MsgBox(strMSG, vbExclamation + vbYesNo, cnsTitle) = vbYes Then
        ' ゼロを上書き
        intNUM = 0
        ' エラー発生箇所の次に進める
        Resume Next
    End If

'===================================================================================================
' 終了
TEST3_EXIT:
    On Error GoTo 0
End Sub
このサンプルは、エラー時の表示メッセージを「はい」「いいえ」の問い合わせに変更し、「はい」が選択されたら、「intNUM」には「0」をセットして「Resume Next」でエラーの次行に戻しています。
エラー処理で「0」をセットするのを「vrnINPUT」として、「Resume Next」を「Resume」だけにしても同じ作用になります。Nextのない「Resume」ではエラーの起こった行に戻ってやり直すことができます。
もし、強制的に「0」にして構わないような処理であれば、「If」を取ってしまえばエラー時に何も表示せずに「0」置き換えして進められます。
ちなみに、メッセージ(MsgBox)に「はい」「いいえ」などのボタンを付けることもできるのが判ります。

エラー処理を判断に利用してしまう例もあります。
ファイル内容の表示(正常終了)
これだけ見ても何だか判りませんが、これは本ブックと同じフォルダから「HOGEHOGE.txt」を読み出した内容です。もちろんこのファイルは元々はなかったのですが、ファイルがなければ初期値で作ってしまうというサンプルです。

'***************************************************************************************************
'* 処理名　：TEST4
'* 機能　　：テスト④
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：エラー処理を判断に利用する例
'* 注意事項：
'***************************************************************************************************
Sub TEST4()
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "TEST4"
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim blnOpen As Boolean                                          ' ファイルOpen判定
    Dim strFilename As String                                       ' ファイル名
    Dim strRec As String                                            ' レコードWORK
    Dim strMSG As String                                            ' メッセージWORK

    On Error GoTo TEST4_ERR
    Set objFso = New FileSystemObject
    ' ファイル名を編集
    strFilename = objFso.BuildPath(ThisWorkbook.Path, "HOGEHOGE.txt")
    ' ﾌｧｲﾙをOPENする(エラー発生)
    Set objTs = objFso.OpenTextFile(strFilename, ForReading, False)
    blnOpen = True
    strRec = objTs.ReadLine
    ' 処理結果表示
    MsgBox "レコード内容=" & strRec, vbInformation, cnsTitle
    GoTo TEST4_EXIT

'===================================================================================================
' エラー時の飛び先(行ラベル)
TEST4_ERR:
    ' ｢ファイルが見つかりません｣か
    If Err.Number = 53 Then
        ' ファイル無しの時は代替処置でファイルを作成
        Set objTs = objFso.CreateTextFile(strFilename, False)
        objTs.WriteLine "abc"
        objTs.Close
        ' エラー発生行に戻る
        Resume
    Else
        ' その他エラーはメッセージ表示
        strMSG = "実行時エラー:" & Err.Number & " " & Err.Description
        ' エラーメッセージを表示
        MsgBox strMSG, vbCritical, cnsTitle
    End If

'===================================================================================================
' 終了
TEST4_EXIT:
    ' ファイルClose
    If blnOpen Then objTs.Close
    Set objFso = Nothing
    On Error GoTo 0
End Sub
このサンプルでは、エラー処理でメッセージ表示させていません。単純にあるべきファイルがなければ自動的に「初期値="abc"」で作成してしまう処理です。作成したらもう一度エラー箇所(読み出しでOPENした所)に戻って処理を再開します。2度目はエラー処理でファイルが作成されていますから、再度エラーにはなりません。
※このサンプル(TEST4)を動かすと、上記ファイルが本当に作成されます。
※本処理のみファイルI/Oを伴うため「Microsoft Scripting Runtime」を参照設定しています。

エラー時飛び先ラベルを作らない方法
エラー時飛び先ラベルを作らない方法
VBAでの実行時エラー処理はほとんどがこれまでのような「エラー時飛び先ラベル」を作る方法ですが、 実行時エラーの発生箇所が局所に限られている場合は「エラー時飛び先ラベル」を作らないで処理することも可能です。

'***************************************************************************************************
'* 処理名　：TEST5
'* 機能　　：テスト⑤
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年12月30日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：エラー時飛び先ラベルを作らない方法
'* 注意事項：
'***************************************************************************************************
Sub TEST5()
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "TEST5"
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim tblINPUT As Variant                                         ' 入力値WORK(テーブル利用)
    Dim intNUM As Integer                                           ' 転記先変数(整数)
    Dim strMSG As String                                            ' メッセージWORK
    tblINPUT = Array(1, 2, 3, "a", 5)
    On Error Resume Next
    ' tblINPUTを巡回
    Do While lngIx <= UBound(tblINPUT)
        ' 処理過程をDebug表示
        Debug.Print CStr(lngIx) & "、値=" & tblINPUT(lngIx)
        ' 整数型変数に転記
        intNUM = tblINPUT(lngIx)
        ' エラー検査
        If Err.Number <> 0 Then
            ' エラーメッセージを編集
            strMSG = "実行時エラー:" & Err.Number & " " & Err.Description & vbCr & _
                     "入力データは「" & tblINPUT(lngIx) & "｣です。(IX=" & lngIx & ")"
            ' エラーメッセージを表示
            MsgBox strMSG, vbCritical, cnsTitle
            Exit Do
        End If
        ' 次へ
        lngIx = lngIx + 1
    Loop
    On Error GoTo 0
End Sub
Do Whileのループ処理の前に「On Error Resume Next」が記述されており、ループ処理の後で「On Error GoTo 0」で戻されています。
この「On Error Resume Next」から「On Error GoTo 0」(又はプロシージャの終了)の間は 実行時エラーが発生しても以降の処理が行なわれてしまいます。
このため処理記述側で「エラー検査」を行ない、エラー発生時は必要な処置を記述する必要があります。
実行時エラーの対象記述が多いとその処置の記述が膨大になり、逆に記述が煩雑になって主要ロジックが見にくくなってしまう場合もあるので、 比較的単純な構造のプロシージャで実行時エラーの発生箇所が局所に限られている場合でなければ特段お勧めする方法ではありません。

複数のプロシージャを組み合わせる場合は？
複数のプロシージャを組み合わせて利用し、それぞれのプロシージャにエラー処理を組み込む場合は注意が必要です。
  • まずは、それぞれのプロシージャに単純にエラー時のエラー表示を組み込んでみます。
    先頭の方の画像からサンプルがダウンロードできますが、その中の「04_OnError2.xlsm」を使用しています。
    親子関係の3つのプロシージャがありますが、それぞれでわざとエラーを起こしています。
    但し、エラーメッセージだけは処理中は累積させておき、最後に表示するようにしています。
    実行させると、
    複数プロシージャでの処理結果
    このようになりました。カッコ内はエラーが発生したプロシージャ名で、エラーの発生順に上から並んでいます。
    ソースコードは以下のようになっています。
    
'***************************************************************************************************
'   エラーテスト                                                    OnErrorTest1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   上層プロシージャで｢On Error GoTo｣を設定した後に下層プロシージャを呼び出す。
'   呼ばれた下層プロシージャでも｢On Error GoTo｣を設定し、その後上層プロシージャ側に戻った時に
'   下層プロシージャ呼び出し前に設定した｢On Error GoTo｣が有効なのかをテストする。
'   3層のプロシージャを用意しており、それぞれ終了時点では｢On Error GoTo 0｣を行なっている。
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/08/13(1.00)新規作成
'19/11/03(1.10)エラー表示方法の合理化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "エラーテスト"

'***************************************************************************************************
'   ■■■ メイン処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST1
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年11月03日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub TEST1()
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST1"                           ' プロシージャ名
    Dim objMsgIcon As VbMsgBoxStyle                                 ' メッセージアイコン
    Dim strErrMSG As String                                         ' エラーメッセージ
    objMsgIcon = vbExclamation
    On Error GoTo TEST1_ERROR
    Call TEST2(objMsgIcon, strErrMSG)
    Err.Raise 61    ' ←ディスクの空き容量が不足しています。
    GoTo TEST1_EXIT

'===================================================================================================
' エラー処理
TEST1_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST1_ERROR"

'===================================================================================================
' 終了
TEST1_EXIT:
    ' エラーがあるか
    If strErrMSG <> "" Then
        MsgBox strErrMSG, objMsgIcon, g_cnsTitle
    End If
    On Error GoTo 0
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST2
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = メッセージアイコン(Object)  ※Ref参照
'* 　　　　　Arg2 = エラーメッセージ(String)    ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年11月03日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TEST2(ByRef objMsgIcon As VbMsgBoxStyle, ByRef strErrMSG As String)
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST2"                           ' プロシージャ名
    On Error GoTo TEST2_ERROR
    Call TEST3(objMsgIcon, strErrMSG)
    Err.Raise 62    ' ←ファイルにこれ以上データがありません。
    GoTo TEST2_EXIT

'===================================================================================================
' エラー処理
TEST2_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST2_ERROR"

'===================================================================================================
' 終了
TEST2_EXIT:
    On Error GoTo 0
End Sub

'***************************************************************************************************
'* 処理名　：TEST3
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = メッセージアイコン(Object)  ※Ref参照
'* 　　　　　Arg2 = エラーメッセージ(String)    ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年11月03日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TEST3(ByRef objMsgIcon As VbMsgBoxStyle, ByRef strErrMSG As String)
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST3"                           ' プロシージャ名
    On Error GoTo TEST3_ERROR
    Err.Raise 63    ' ←レコード番号が不正です。
    GoTo TEST3_EXIT

'===================================================================================================
' エラー処理
TEST3_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST3_ERROR"

'===================================================================================================
' 終了
TEST3_EXIT:
    On Error GoTo 0
End Sub

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：GP_AppendMessage
'* 機能　　：メッセージ累積
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 今回メッセージ(String)
'* 　　　　　Arg2 = 累積メッセージ(String)              ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：改行を挟んでメッセージを累積する
'* 注意事項：
'***************************************************************************************************
Private Sub GP_AppendMessage(ByVal strAddMSG As String, ByRef strRuiMSG As String)
    '-----------------------------------------------------------------------------------------------
    If strRuiMSG <> "" Then strRuiMSG = strRuiMSG & vbCrLf
    strRuiMSG = strRuiMSG & strAddMSG
End Sub

'***************************************************************************************************
'* 処理名　：FP_EditFatalMSG
'* 機能　　：例外メッセージ編集
'---------------------------------------------------------------------------------------------------
'* 返り値　：編集後メッセージ(String)
'* 引数　　：Arg1 = プロシージャ名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月03日
'* 作成者　：井上　治
'* 更新日　：2019年11月03日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_EditFatalMSG(ByVal strProcName As String) As String
    '-----------------------------------------------------------------------------------------------
    FP_EditFatalMSG = Err.Number & " " & Err.Description & "(" & strProcName & ")"
End Function

'----------------------------------------<< End of Source >>----------------------------------------
    親プロシージャ「TEST1」から子プロシージャ「TEST2」が呼び出され、その「TEST2」から「TEST3」が呼び出される構造です。
    各処理ともにErr.Raiseを使って実行時エラーを起こさせていますが、自分のプロシージャでエラーを発生させる前に下位プロシージャを呼び出しているのでエラーの表示順もこのようになるわけです。
    エラー表示をまとめているのでエラーの発生回数なども判りますが、一般には処理上致命的なエラーが発生したら以降の処理が流れてしまうように設計することは誤りです。
    エラー処理時にEndステートメントを使って強引に止めてしまう方法もありますが、それでは単にエラー処理を行なわないで実行時エラーで止まってしまうのとあまり変わりません。



     また、このサンプルでは上位側で先に「On Error Goto」の記述を行なってから、下位プロシージャを呼び出し、その後自プロシージャに戻ってから「Err.Raise」しています。
    下位プロシージャを呼び出した際には下位プロシージャ側でも「On Error Goto」の記述を通るため、戻ってきてからの「Err.Raise」が正しく判断されているのかも確認してみて下さい。

  • では、上記の対策を行ないます。
    下位プロシージャ2つは「Funtion」プロシージャに変更し、処理成功時は「True」を返すように変更しました。
    サンプルは「04_OnError3.xlsm」を使用しています。
    上位側では下位プロシージャが不成功の場合は終了するようにしています。
    処理結果は、
    複数プロシージャでの処理結果
    このようになりました。先頭のエラーのみ終了したことになりますが、エラー表示自体は起動した「TEST1」で行なっているので、 下位プロシージャ側で終了してしまったわけではありません。
    ソースコードは以下のようになっています。
    
'***************************************************************************************************
'   エラーテスト                                                    OnErrorTest2(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   上層プロシージャで｢On Error GoTo｣を設定した後に下層プロシージャを呼び出す。
'   呼ばれた下層プロシージャでも｢On Error GoTo｣を設定し、その後上層プロシージャ側に戻った時に
'   下層プロシージャ呼び出し前に設定した｢On Error GoTo｣が有効なのかをテストする。
'   3層のプロシージャを用意しており、それぞれ終了時点では｢On Error GoTo 0｣を行なっている。
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/08/13(1.00)新規作成
'19/11/03(1.10)エラー表示方法の合理化、他
'19/12/30(1.20)サブ処理側のプロシージャをFunctionに変更し上位側で処理成否を判断させる
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "エラーテスト"

'***************************************************************************************************
'   ■■■ メイン処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST1
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub TEST1()
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST1"                           ' プロシージャ名
    Dim objMsgIcon As VbMsgBoxStyle                                 ' メッセージアイコン
    Dim strErrMSG As String                                         ' エラーメッセージ
    objMsgIcon = vbExclamation
    On Error GoTo TEST1_ERROR
    ' 下位側の不成功時は終了
    If Not TEST2(objMsgIcon, strErrMSG) Then GoTo TEST1_EXIT
    Err.Raise 61    ' ←ディスクの空き容量が不足しています。
    GoTo TEST1_EXIT

'===================================================================================================
' エラー処理
TEST1_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST1_ERROR"

'===================================================================================================
' 終了
TEST1_EXIT:
    ' エラーがあるか
    If strErrMSG <> "" Then
        MsgBox strErrMSG, objMsgIcon, g_cnsTitle
    End If
    On Error GoTo 0
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST2
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = メッセージアイコン(Object)  ※Ref参照
'* 　　　　　Arg2 = エラーメッセージ(String)    ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function TEST2(ByRef objMsgIcon As VbMsgBoxStyle, ByRef strErrMSG As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST2"                           ' プロシージャ名
    TEST2 = False
    On Error GoTo TEST2_ERROR
    ' 下位側の不成功時は処理を抜ける
    If Not TEST3(objMsgIcon, strErrMSG) Then GoTo TEST2_EXIT
    Err.Raise 62    ' ←ファイルにこれ以上データがありません。
    TEST2 = True
    GoTo TEST2_EXIT

'===================================================================================================
' エラー処理
TEST2_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST2_ERROR"

'===================================================================================================
' 終了
TEST2_EXIT:
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名　：TEST3
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = メッセージアイコン(Object)  ※Ref参照
'* 　　　　　Arg2 = エラーメッセージ(String)    ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年12月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function TEST3(ByRef objMsgIcon As VbMsgBoxStyle, ByRef strErrMSG As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Const cnsProcName As String = "TEST3"                           ' プロシージャ名
    TEST3 = False
    On Error GoTo TEST3_ERROR
    Err.Raise 63    ' ←レコード番号が不正です。
    ' 処理成功時はTrueを返す
    TEST3 = True
    GoTo TEST3_EXIT

'===================================================================================================
' エラー処理
TEST3_ERROR:
    Call GP_AppendMessage(FP_EditFatalMSG(cnsProcName), strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST3_ERROR"

'===================================================================================================
' 終了
TEST3_EXIT:
    On Error GoTo 0
End Function

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：GP_AppendMessage
'* 機能　　：メッセージ累積
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 今回メッセージ(String)
'* 　　　　　Arg2 = 累積メッセージ(String)              ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：改行を挟んでメッセージを累積する
'* 注意事項：
'***************************************************************************************************
Private Sub GP_AppendMessage(ByVal strAddMSG As String, ByRef strRuiMSG As String)
    '-----------------------------------------------------------------------------------------------
    If strRuiMSG <> "" Then strRuiMSG = strRuiMSG & vbCrLf
    strRuiMSG = strRuiMSG & strAddMSG
End Sub

'***************************************************************************************************
'* 処理名　：FP_EditFatalMSG
'* 機能　　：例外メッセージ編集
'---------------------------------------------------------------------------------------------------
'* 返り値　：編集後メッセージ(String)
'* 引数　　：Arg1 = プロシージャ名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月03日
'* 作成者　：井上　治
'* 更新日　：2019年11月03日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_EditFatalMSG(ByVal strProcName As String) As String
    '-----------------------------------------------------------------------------------------------
    FP_EditFatalMSG = Err.Number & " " & Err.Description & "(" & strProcName & ")"
End Function

'----------------------------------------<< End of Source >>----------------------------------------
    これだと、エラーメッセージを累積させている意味がないように見えます。
    このサンプルでは致命エラーだけなのでそうかもしれませんが、一般的な処理では致命エラー以外の論理エラーも処理中に積み上げておいて最後にまとめて表示させるようなことがよくあって、 そのためにも対応できるようにこのような方法を採っています。
    エラーメッセージ用のアイコンを「警告」か「致命」か切り替えているのも同じ理由です。

  • 少し「無精」なやり方も考えられます。
    サンプルは「04_OnError4.xlsm」を使用しています。
    このような上下関係の複数プロシージャでは上位側のエラー処置は下位側でも有効となります。
    処理結果は、
    複数プロシージャでの処理結果
    このようになりました。このエラー表示は１つ上の「04_OnError3.xlsm」と同じです。
    エラートラップは起動した「TEST1」だけですが、このように「TEST3」で発生した実行時エラーも捕捉されています。
    ソースコードは以下のようになっています。
    
'***************************************************************************************************
'   エラーテスト                                                    OnErrorTest3(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   最上層プロシージャで｢On Error GoTo｣を設定した後に下層プロシージャを呼び出す。
'   呼ばれた下層プロシージャでは｢On Error GoTo｣を設定せずに最上層プロシージャのトラップが
'   有効なのかをテストする。3層のプロシージャを用意している。
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/08/13(1.00)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "エラーテスト"

'***************************************************************************************************
'   ■■■ メイン処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST1
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub TEST1()
    '-----------------------------------------------------------------------------------------------
    Dim objMsgIcon As VbMsgBoxStyle                                 ' メッセージアイコン
    Dim strProc As String                                           ' プロシージャ
    Dim strErrMSG As String                                         ' エラーメッセージ
    objMsgIcon = vbExclamation
    On Error GoTo TEST1_ERROR
    Call TEST2(strProc)
    strProc = "TEST1"
    Err.Raise 61    ' ←ディスクの空き容量が不足しています。
    GoTo TEST1_EXIT

'===================================================================================================
' エラー処理
TEST1_ERROR:
    Call GP_AppendMessage(Err.Number & " " & Err.Description & "(" & strProc & ")", strErrMSG)
    objMsgIcon = vbCritical
    Debug.Print "TEST1_ERROR"

'===================================================================================================
' 終了
TEST1_EXIT:
    ' エラーがあるか
    If strErrMSG <> "" Then
        MsgBox strErrMSG, objMsgIcon, g_cnsTitle
    End If
    On Error GoTo 0
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：TEST2
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = プロシージャ(String)        ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TEST2(ByRef strProc As String)
    '-----------------------------------------------------------------------------------------------
    Call TEST3(strProc)
    strProc = "TEST2"
    Err.Raise 62    ' ←ファイルにこれ以上データがありません。
End Sub

'***************************************************************************************************
'* 処理名　：TEST3
'* 機能　　：テスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = プロシージャ(String)        ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TEST3(ByRef strProc As String)
    '-----------------------------------------------------------------------------------------------
    strProc = "TEST3"
    Err.Raise 63    ' ←レコード番号が不正です。
End Sub

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：GP_AppendMessage
'* 機能　　：メッセージ累積
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 今回メッセージ(String)
'* 　　　　　Arg2 = 累積メッセージ(String)              ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年08月13日
'* 作成者　：井上　治
'* 更新日　：2019年08月13日
'* 更新者　：井上　治
'* 機能説明：改行を挟んでメッセージを累積する
'* 注意事項：
'***************************************************************************************************
Private Sub GP_AppendMessage(ByVal strAddMSG As String, ByRef strRuiMSG As String)
    '-----------------------------------------------------------------------------------------------
    If strRuiMSG <> "" Then strRuiMSG = strRuiMSG & vbCrLf
    strRuiMSG = strRuiMSG & strAddMSG
End Sub

'----------------------------------------<< End of Source >>----------------------------------------
    これはどうでしょうか。記述は結構シンプルになりました。
    エラー処理記述を親プロシージャだけに書いて、子プロシージャは単純に処理記述だけにしてしまいます。 子プロシージャは処理結果通知は行なわないので「Sub」プロシージャに戻しています。
    今回のサンプルではエラーメッセージの表示時にプロシージャ名を表示させているので、これはRef参照で上位側に通知させています。 注意が必要なのはこのプロシージャ名を上位に通知させるための変数にプロシージャ名をセットするタイミングで、 プロシージャの先頭でセットしてしまうと、以降に下位プロシージャを呼び出した時に下位側でプロシージャ名が上書きされてしまうことです。
    下位プロシージャをいくつも呼び出すようなケースでは戻ってくる都度、現在プロシージャ名を再セットさせる必要が発生します。



     エラーメッセージだけのことであればこのようなエラー処理でも構わないのですが、複雑な処理ではエラー処理時にたとえば「開いているファイルを閉じる」とかプロシージャごとの固有の「後始末」が発生することが多いので、このような方法が使えるケースは少ないと思います。