グローバルエラー処理を行う方法はありますか?
すべてのモジュール内で発生したエラーをキャッチするコードを Workbook コードに入れることはできますか?
各モジュールに同じエラー ハンドラを配置することもできますが、もっと一般的なものを探しています。
このようにグローバル変数として保存されているシート名があるのでお願いしますSheets(QuoteName)。エラーが発生すると、これらのグローバル変数は失われます。グローバル変数の名前を変更するマクロがありますが、これをWorkbook_BeforeSave.
グローバルエラーハンドラーに移動し、下付き文字が範囲外のエラーを取得した場合にグローバル変数の名前を変更したいSheets(QuoteName)
Sid がコメントで既に述べたように、中央のエラー ハンドラはありません。
ベスト プラクティスは、ローカル エラー ハンドラから呼び出される中央エラー処理ルーチンを用意することです。優れたMZ-Toolsを見てみましょう。ボタン ( Ctrl- )を押すだけで、デフォルトのエラー ハンドラを定義できますE。このエラー ハンドラはカスタマイズできます。また、モジュールやサブ名を含めることもできます。
さらに、 Daily Dose of Excelでこの投稿を確認してください。これは、この本で提案されているエラー ハンドラの Dick Kusleika の OO バージョンです(私はこれを強くお勧めします)。
アクセスの問題を処理するためにまとめたコードを次に示します
すべてのサブルーチンにエラー チェックを入れますが、関数には入れません。サブスクライブには親フォーム (ACCESS) が必要です。または、フォーム名を手動で入力する必要があります。複数の行にまたがる潜水艦は容赦なく叩かれます。
2 つのサブは、モジュールの下部にある必要があります。
globalerror は、ブール値のグローバルerrortrackingを調べて、すべてをログに記録するか、エラーのみをログに記録するかを確認します
作成する必要があるテーブル ErrorTracking があります。それ以外の場合は、1990 から 2160 までコメント アウトします。
実行すると、プロジェクト内のすべての行番号が削除されてから追加されるため、エラー メッセージに行 # が含まれる場合があります。
私がコーディングしたもの以外で動作するかどうかはわかりません。
必ず VBA のコピーを実行してテストしてください。これは、プロジェクトのすべてのコード行を文字通り書き換えるからです。私が失敗して、バックアップしなかった場合、プロジェクトは壊れています。
Public Sub globalerror(Name As String, number As Integer, Description As String, source As String)
1970 Dim db As DAO.Database
1980 Dim rst As DAO.Recordset
1990 If errortracking Or (Err.number <> 0) Then
2000 Set db = CurrentDb
2010 Set rst = db.OpenRecordset("ErrorTracking")
2020 rst.AddNew
2030 rst.Fields("FormModule") = Name
2040 rst.Fields("ErrorNumber") = number
2050 rst.Fields("Description") = Description
2060 rst.Fields("Source") = source
2070 rst.Fields("timestamp") = Now()
2080 rst.Fields("Line") = Erl
2100 rst.Update
2110 rst.Close
2120 db.Close
2130 End If
2140 If Err.number = 0 Then
2150 Exit Sub
2160 End If
2170 MsgBox "ERROR" & vbCrLf & "Location: " & Name & vbCrLf & "Line: " & Erl & vbCrLf & "Number: " & number & vbCrLf & "Description: " & Description & vbCrLf & source & vbCrLf & Now() & vbCrLf & vbCrLf & "custom message"
2180 End Sub
Private Sub CleanVBA_Click()
Dim linekill As Integer
Dim component As Object
Dim index As Integer
Dim str As String
Dim str2a As String
Dim linenumber As Integer
Dim doline As Boolean
Dim skipline As Boolean
Dim selectflag As Boolean
Dim numstring() As String
skipline = False
selectflag = False
tabcounter = 0
For Each component In Application.VBE.ActiveVBProject.VBComponents
linekill = component.CodeModule.CountOfLines
linenumber = 0
For i = 1 To linekill
str = component.CodeModule.Lines(i, 1)
doline = True
If Right(Trim(str), 1) = "_" Then
doline = False
skipline = True
End If
If Len(Trim(str)) = 0 Then
doline = False
End If
If InStr(Trim(str), "'") = 1 Then
doline = False
End If
If selectflag Then
doline = False
End If
If InStr(str, "Select Case") > 0 Then
selectflag = True
End If
If InStr(str, "End Select") > 0 Then
selectflag = False
End If
If InStr(str, "Global ") > 0 Then
doline = False
End If
If InStr(str, "Sub ") > 0 Then
doline = False
End If
If InStr(str, "Option ") > 0 Then
doline = False
End If
If InStr(str, "Function ") > 0 Then
doline = False
End If
If (InStr(str, "Sub ") > 0) Then
If InStr(component.CodeModule.Lines(i + 1, 1), "On Error GoTo error") <> 0 Then
GoTo skipsub
End If
str2a = component.CodeModule.Name
index = InStr(str, "Sub ") ' sub
str = Right(str, Len(str) - index - 3) ' sub
' index = InStr(str, "Function ") ' function
' str = Right(str, Len(str) - index - 8) 'function
index = InStr(str, "(")
str = Left(str, index - 1)
varReturn = SysCmd(acSysCmdSetStatus, "Editing: " & str2a & " : " & str)
DoEvents
If (str = "CleanVBA_Click") Then
MsgBox "skipping self"
GoTo selfie
End If
If str = "globalerror" Then
MsgBox "skipping globalerror"
GoTo skipsub
End If
component.CodeModule.InsertLines i + 1, "On Error GoTo error"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, "error:"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, "Call globalerror(Me.Form.Name & """ & "-" & str & """, Err.number, Err.description, Err.source)"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, " "
i = i + 1
linekill = linekill + 1
If (str = "MashVBA_Click") Then
MsgBox "skipping self"
MsgBox component.CodeModule.Name & " " & str
GoTo selfie
End If
Else
If skipline Then
If doline Then
skipline = False
End If
doline = False
End If
If doline Then
linenumber = linenumber + 10
numstring = Split(Trim(str), " ")
If Len(numstring(0)) >= 2 Then
If IsNumeric(numstring(0)) Then
str = Replace(str, numstring(0), "")
End If
End If
component.CodeModule.ReplaceLine i, linenumber & " " & str
End If
End If
skipsub:
Next i
selfie:
Next
varReturn = SysCmd(acSysCmdSetStatus, " ")
MsgBox "Finished"
End Sub