有没有办法进行全局错误处理?
我可以在工作簿代码中添加一些代码来捕获所有模块中发生的任何错误吗?
我可以在每个模块中放置相同的错误处理程序,但我正在寻找更通用的东西。
我问是因为我有像这样存储为全局变量的工作表名称Sheets(QuoteName)
。如果出现错误,则这些全局变量将丢失。我有一个宏可以重命名全局变量,但我把它放在Workbook_BeforeSave
.
如果我收到下标超出范围错误,我希望它转到全局错误处理程序并重命名全局变量Sheets(QuoteName)
正如 Sid 在评论中已经提到的,没有中央错误处理程序。
最佳实践是有一个从本地错误处理程序调用的中央错误处理例程。看看伟大的MZ-Tools:它可以在按下按钮 ( Ctrl- E) 时定义默认错误处理程序。您可以自定义此错误处理程序 - 它还可以包含模块和/或子名称!
此外,请查看Excel 每日剂量中的这篇文章。这是 Dick Kusleika 在本书中提出的错误处理程序的 OO 版本(我强烈推荐)。
这是我为解决访问问题而拼凑的一些代码
它在所有子程序中进行错误检查,但不在函数中。subs 必须有一个父表单(ACCESS),或者,您必须手动输入表单名称。超过一条线的潜艇将被无情地打击。
两个潜艇必须位于模块的底部。
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