6

有没有办法进行全局错误处理?

我可以在工作簿代码中添加一些代码来捕获所有模块中发生的任何错误吗?

我可以在每个模块中放置相同的错误处理程序,但我正在寻找更通用的东西。

我问是因为我有像这样存储为全局变量的工作表名称Sheets(QuoteName)。如果出现错误,则这些全局变量将丢失。我有一个宏可以重命名全局变量,但我把它放在Workbook_BeforeSave.

如果我收到下标超出范围错误,我希望它转到全局错误处理程序并重命名全局变量Sheets(QuoteName)

4

2 回答 2

7

正如 Sid 在评论中已经提到的,没有中央错误处理程序。

最佳实践是有一个从本地错误处理程序调用的中央错误处理例程。看看伟大的MZ-Tools:它可以在按下按钮 ( Ctrl- E) 时定义默认错误处理程序。您可以自定义此错误处理程序 - 它还可以包含模块和/或子名称!

此外,请查看Excel 每日剂量中的这篇文章。这是 Dick Kusleika 在本书中提出的错误处理程序的 OO 版本(我强烈推荐)。

于 2013-02-18T21:31:37.880 回答
-2

这是我为解决访问问题而拼凑的一些代码

它在所有子程序中进行错误检查,但不在函数中。subs 必须有一个父表单(ACCESS),或者,您必须手动输入表单名称。超过一条线的潜艇将被无情地打击。

两个潜艇必须位于模块的底部。

  • globalerror是您的错误管理例程
  • CleaVBA_click更改您的 VBA 代码,将行号添加到所有内容

globalerror 查看一个布尔全局错误跟踪以查看它是记录所有内容还是仅记录错误

有一个必须创建的表 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
于 2014-10-16T12:58:04.297 回答