Excelマクロ(エラーハンドリング)

動作確認マクロ（.xlsmファイル）

Sheet1.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sheet1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Public Sub Main()
    On Error GoTo ERROR
    If Range("A2").Value = 1 Then
        FinalizeError = True
    Else
        FinalizeError = False
    End If
    Call Module1.Procedure1
    Exit Sub
ERROR:
    Dim StackTrace As Variant
    Dim i As Integer
    StackTrace = Split(Err.Source, vbCrLf)
    For i = LBound(StackTrace) To UBound(StackTrace)
        Range("A" & i + 5).Value = StackTrace(i)
    Next i
    Call MsgBox(Err.Description, vbExclamation + vbOKOnly)
    End
End Sub

Module1.bas

Attribute VB_Name = "Module1"
Option Explicit

Private Const MODULE = "モジュール1"

Public Sub Procedure1()
    On Error GoTo ERROR
    Call SubProcedure1
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "プロシージャ1")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure1()
    On Error GoTo ERROR
    Call SubProcedure2
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ1")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure2()
    On Error GoTo ERROR
    Call SubProcedure3
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ2")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure3()
    On Error GoTo ERROR
    Call SubProcedure4
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ3")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure4()
    On Error GoTo ERROR
    Call SubProcedure5
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ4")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure5()
    On Error GoTo ERROR
    Call Module2.Procedure2
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ5")
    Call ErrHndlr.RaiseError(Err)
End Sub

Module2.bas

Attribute VB_Name = "Module2"
Option Explicit

Private Const MODULE = "モジュール2"

Public Sub Procedure2()
    On Error GoTo ERROR
    Call SubProcedure1
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "プロシージャ2")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure1()
    On Error GoTo ERROR
    Call SubProcedure2
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ1")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure2()
    On Error GoTo ERROR
    Call SubProcedure3
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ2")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure3()
    On Error GoTo ERROR
    Call SubProcedure4
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ3")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure4()
    On Error GoTo ERROR
    Call SubProcedure5
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ4")
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub SubProcedure5()
    On Error GoTo ERROR
    Call ExternalProcedure
    'Call Procedure3
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "サブプロシージャ5")
    Call Finalizer(ErrHndlr)
    Call ErrHndlr.RaiseError(Err)
End Sub

Private Sub Finalizer(PreOccured As ErrorHandler)
    On Error GoTo ERROR
    If FinalizeError Then
        Call Err.Raise(Number:=vbObjectError + 5, Description:="Finalizeエラー")
    End If
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetErrorHandler(PreOccured)
    Call ErrHndlr.RaiseFinalizeError(Err, SAMPLESYSTEM, MODULE, "後処理プロシージャ")
End Sub

Module3.bas

Attribute VB_Name = "Module3"
Option Explicit

Private Const MODULE = "モジュール3"

Public Sub Procedure3()
    On Error GoTo ERROR
    Call Err.Raise(Number:=vbObjectError + 1, Description:="エラー")
    Exit Sub
ERROR:
    Dim ErrHndlr As ErrorHandler
    Set ErrHndlr = New ErrorHandler
    Call ErrHndlr.SetError(Err, SAMPLESYSTEM, MODULE, "プロシージャ3")
    Call ErrHndlr.RaiseError(Err)
End Sub

Constant.bas

Attribute VB_Name = "Constant"
Option Explicit

Public Const SAMPLESYSTEM As String = "【サンプル】"
Public FinalizeError As Boolean

ErrorHandler.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ErrorHandler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private myNumber As Long
Private mySource As String
Private myDescription As String

Public Property Get Number() As Long
    Number = myNumber
End Property

Public Property Get Source() As String
    Source = mySource
End Property

Public Property Get Description() As String
    Description = myDescription
End Property

Public Sub SetError(ByVal Occured As ErrObject, ByVal Notice As String, ByVal CatchModule As String, ByVal CatchMethod As String)
    myNumber = Occured.Number
    mySource = Occured.Source & vbCrLf & Notice & CatchModule & "." & CatchMethod
    myDescription = Occured.Description
End Sub

Public Sub SetErrorHandler(ByVal PreOccured As ErrorHandler)
    myNumber = PreOccured.Number
    mySource = PreOccured.Source
    myDescription = PreOccured.Description
End Sub

Public Sub RaiseError(ByVal Occured As ErrObject)
    Occured.Clear

    Call Err.Raise(myNumber, mySource, myDescription)
End Sub

Public Sub RaiseFinalizeError(ByVal Occured As ErrObject, ByVal Notice As String, ByVal CatchModule As String, ByVal CatchMethod As String)
    Occured.Clear

    Call Err.Raise(myNumber, mySource & vbCrLf & Notice & CatchModule & "." & CatchMethod, myDescription)
End Sub

外部参照アドイン（.xlamファイル）

Module1.bas

Attribute VB_Name = "Module1"
Option Explicit

Public Sub ExternalProcedure()
    Call Err.Raise(Number:=vbObjectError + 9, Description:="外部エラー")
End Sub