Excel VBA全局錯誤處理

Question

有沒有辦法進行全局錯誤處理？

我可以在工作簿代碼中放入一些代碼來捕獲所有模塊中發生的任何錯誤嗎？

我可以在每個模塊中放置相同的錯誤處理程序，但我正在尋找更通用的東西。

我問，因為我有工作表名稱存儲為全局變量，如此Sheets(QuoteName) 。 如果存在錯誤，則這些全局變量將丟失。 我有一個宏將重命名全局變量，但我把它放在Workbook_BeforeSave 。

我希望它轉到全局錯誤處理程序並重命名全局變量如果我得到一個下標超出范圍的Sheets(QuoteName)

Answer 1

正如Sid在評論中已經提到的那樣，沒有中央錯誤處理程序。

最佳實踐是使用從本地錯誤處理程序調用的中央錯誤處理例程。 看一下優秀的MZ-Tools ：只需按一下按鈕（ Ctrl - E ），就可以定義一個默認的錯誤處理程序。 您可以自定義此錯誤處理程序 - 它還可以包含模塊和/或子名稱！

另外，請查看Daily Dose of Excel上的這篇文章。 這是Dick Kusleika在本書中提出的錯誤處理程序的OO版本（我強烈推薦）。

Answer 2

這里是一些代碼，我把它們放在一起來處理訪問中的問題

它將錯誤檢查放在所有潛艇中，但不包括功能。 subs必須有一個父表單（ACCESS），或者你必須手動放置表單名稱。 將繼續超過一條線路的潛艇將遭到無情的打擊。

兩個潛艇必須位於模塊的底部。

• globalerror是您的錯誤管理例程
• CleaVBA_click更改您的VBA代碼，為所有內容添加行＃

globalerror查看布爾全局錯誤跟蹤以查看它是記錄所有內容還是僅記錄錯誤

有一個表必須創建錯誤跟蹤，否則只需注釋掉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