VBA エラートラップとユーザ定義

エラートラップのMyテンプレート

同じ処理コードを書くのは嫌だから、すぐにパーツ化する
すごく便利だし、メンテナンス性が向上する

ただ、エラー制御や処理中断した場合が面倒になってくるんだよね。
それで、今回は、すっきりで、テンプレートをつくってみた。
処理中断とエラーが一緒になっているけど、まあ、いいかあと・・・
基本的にエラートラップを親子でするとごちゃごちゃするので、親が一元管理するパターン

そのための方針

  1. 親側では、On Error GoToを必須とする
    • エラーは親の ErrHandler: で一括処理
  2. 子側では、On Error Resume Nextなどのエラートラップをしない
    • エラーは親に自然伝播させる
  3. 何が原因で IsSuccess = False なのか不明にならないよう、 ErrorMessageを付ける
    • エラーと中断の理由が識別できる
  4. 複雑怪奇はいや
    • 自己満でもOK

なんちゃってテンプレート（modProcessResultSimple）

Option Explicit
' === ▼ 汎用的な処理結果 Type定義 ===
Public Type ProcessResult
    IsSuccess As Boolean
    ErrorMessage As String
    TextValue As String
    NumericValue As Long
    StringArray() As String '今回未使用
End Type

' === ▼ 共通エラー処理 ===
Public Sub HandleStandardError(Optional ByVal procName As String = "")
    Dim msg As String
    msg = "エラーが発生しました"

    If procName <> "" Then msg = msg & vbNewLine & "[プロシージャ] " & procName
    msg = msg & vbNewLine & "[番号] " & Err.Number
    msg = msg & vbNewLine & "[内容] " & Err.Description

    ' 即時ウィンドウ出力（開発中のデバッグに便利）
    Debug.Print msg

    ' ユーザー通知
    MsgBox msg, vbCritical

    ' エラー情報をクリア（次処理に影響しないように）
    Err.Clear
End Sub

' === ▼ 後始末（画面更新・イベント処理を戻す） ===
Public Sub Cleanup(Optional ByVal restoreEvents As Boolean = True)
    Application.ScreenUpdating = True
    If restoreEvents Then Application.EnableEvents = True
End Sub

' === ▼ メイン処理（親） ===
Public Sub ErrTest()
    Dim res As ProcessResult
    On Error GoTo ErrHandler

    res = subProc1
    If res.IsSuccess Then
        Debug.Print "戻り値1：" & res.NumericValue
    Else
        Debug.Print "[subProc1] 未処理：" & res.ErrorMessage
        GoTo ExitHandler
    End If

    res = subProc2
    If res.IsSuccess Then
        Debug.Print "戻り値2：" & res.TextValue
    Else
        Debug.Print "[subProc2] 未処理：" & res.ErrorMessage
        GoTo ExitHandler
    End If

ExitHandler:
    Call Cleanup
    Exit Sub

ErrHandler:
    Call HandleStandardError("ErrTest")
    Resume ExitHandler
End Sub

' === ▼ 子プロシージャ（数値処理） ===
Public Function subProc1() As ProcessResult
    Dim res As ProcessResult
    Dim n As Long
    Dim s As String
    Dim resNum As Long

    res.IsSuccess = False

    n = 5 ' 正常または 0 でエラーをテスト
    s = "" ' 空文字で中断をテスト

    resNum = 5 / n
    res.NumericValue = resNum

    If s = "" Then
        res.ErrorMessage = "subProc1：空データのため処理中断"
        subProc1 = res
        Exit Function
    End If

    res.IsSuccess = True
    subProc1 = res
End Function

' === ▼ 子プロシージャ（文字列処理） ===
Public Function subProc2() As ProcessResult
    Dim res As ProcessResult
    Dim n As Long
    Dim s As String
    Dim resNum As Long

    res.IsSuccess = False

    n = 0 ' ゼロ除算でエラーをテスト
    s = "aa"

    resNum = 5 / n
    res.NumericValue = resNum

    If s = "" Then
        res.ErrorMessage = "subProc2：空データのため処理中断"
        subProc2 = res
        Exit Function
    End If

    res.TextValue = s
    res.IsSuccess = True
    subProc2 = res
End Function

    コメント