社区 › VB › 使用Acad处理礼仪时出错

MickD 发表于 2007-12-10 18:16:05

使用Acad处理礼仪时出错

大家好，
我现在正处于一个阶段，我严重需要在我的新应用程序中考虑错误处理，我有几个问题。
1）除了通常的“esc”和un cancel和file op处理程序之外，我还应该考虑哪些其他重要的acad错误？
2）我应该把错误处理程序放在我所有的私有或“worker”子中，还是我可以把一个放在用户调用的过程中，
显然会有一些例子，将它们放在私有子中是明智的，例如打开文件等？
3）在我跳进去之前还有其他提示或技巧吗？
谢谢。
**** Hidden Message *****

MickD 发表于 2007-12-10 18:25:17

收到

Bryco 发表于 2007-12-10 18:40:15

1）将代码发布到一个新模块中（我称我的为ErrorControl）
2）添加对MICROSOFT Visual Basic for Application可扩展性5.3
3）无论何时，只要您想在子模块或函数中进行错误控制，只需使子模块处于活动状态，然后转到工具（与保持引用相同的工具下拉）->宏modulename.AutoErrorHandler
"运行"this，错误处理程序将自动编写。
Option Explicit
Dim objIDE As VBE
Dim objPane As CodePane
Dim objMod As CodeModule
   
'Randall Rath
Public Sub AutoErrorHandler()
Dim strProc As String
Dim lngFirst As Long
Dim lngTotal As Long
Dim lngLast As Long
On Error GoTo Err_Control
Set objIDE = Application.VBE
Set objPane = objIDE.ActiveCodePane
Set objMod = objPane.CodeModule
strProc = GetCurrentProc
lngFirst = objMod.ProcBodyLine(strProc, _
vbext_pk_Proc)
lngTotal = objMod.ProcCountLines(strProc, _
vbext_pk_Proc)
lngLast = lngFirst + lngTotal
Call InsertGoto(lngLast, lngFirst)
Call InsertHandler(lngLast, lngFirst)
Set objIDE = Nothing
Set objPane = Nothing
Set objMod = Nothing
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
    Case Else
    MsgBox Err.Description
    Resume Exit_Here
End Select
End Sub
Private Function GetCurrentProc() As String
Dim lngSC As Long 'Start column
Dim lngEC As Long 'End Column
Dim lngSL As Long 'Start Line
Dim lngEL As Long 'End Line
On Error GoTo Err_Control
objPane.GetSelection lngSL, lngSC, _
lngEL, lngEC
'Debug.Print lngSL, lngEL
GetCurrentProc = objMod.ProcOfLine(lngSL, _
vbext_pk_Proc)
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
'Add your Case selections here
    Case Else
    MsgBox Err.Description
    Resume Exit_Here
End Select
End Function
Private Sub InsertGoto(LastLine As Long, _
FirstLine As Long)
Dim lngCnt As Long
Dim strLine As String
On Error GoTo Err_Control
FirstLine = FirstLine + 1
For lngCnt = FirstLine To LastLine
    If Not Right(objMod.Lines(lngCnt - 1, 1), _
    1) = "_" Then
      strLine = objMod.Lines(lngCnt, 1)
      If InStr(1, strLine, "Dim", _
      vbTextCompare) = 0 Then
      objMod.InsertLines lngCnt, _
      vbTab & "On Error GoTo Err_Control"
      Exit For
      End If
    End If
Next lngCnt
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
'Add your Case selections here
    Case Else
    MsgBox Err.Description
    Resume Exit_Here
End Select
End Sub
Private Sub InsertHandler(LastLine As Long, FirstLine As Long)
Dim lngCnt As Long
Dim strLine As String
On Error GoTo Err_Control
For lngCnt = LastLine To FirstLine Step -1
    strLine = objMod.Lines(lngCnt, 1)
    Select Case strLine
    Case "End Sub"
      objMod.InsertLines lngCnt, "Exit_Here:"
      objMod.InsertLines lngCnt + 1, vbTab & _
      "Exit Sub"
      objMod.InsertLines lngCnt + 2, _
      "Err_Control:"
      objMod.InsertLines lngCnt + 3, vbTab & _
      "Select Case Err.Number"
      objMod.InsertLines lngCnt + 4, vbTab & _
      "'Add your Case selections here"
      objMod.InsertLines lngCnt + 5, vbTab & _
      vbTab & "Case Else"
      objMod.InsertLines lngCnt + 6, vbTab & _
      vbTab & "MsgBox Err.Description"
      objMod.InsertLines lngCnt + 7, vbTab & _
      vbTab & "Err.Clear"
      objMod.InsertLines lngCnt + 8, vbTab & _
      vbTab & "Resume Exit_Here"
      objMod.InsertLines lngCnt + 9, vbTab & _
      "End Select"
      Exit For
    Case "End Function"
      objMod.InsertLines lngCnt, "Exit_Here:"
      objMod.InsertLines lngCnt + 1, vbTab & _
      "Exit Function"
      objMod.InsertLines lngCnt + 2, _
      "Err_Control:"
      objMod.InsertLines lngCnt + 3, vbTab & _
      "Select Case Err.Number"
      objMod.InsertLines lngCnt + 4, vbTab & _
      "'Add your Case selections here"
      objMod.InsertLines lngCnt + 5, vbTab & _
      vbTab & "Case Else"
      objMod.InsertLines lngCnt + 6, vbTab & _
      vbTab & "MsgBox Err.Description"
      objMod.InsertLines lngCnt + 7, vbTab & _
      vbTab & "Err.Clear"
      objMod.InsertLines lngCnt + 8, vbTab & _
      vbTab & "Resume Exit_Here"
      objMod.InsertLines lngCnt + 9, vbTab & _
      "End Select"
      Exit For
    End Select
Next lngCnt
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
    Case Else
    MsgBox Err.Description
    Debug.Print Err.Number & Space(2) & Err.Description
    Resume Exit_Here
End Select

End Sub

这是一个示例
Sub Test()
    On Error GoTo Err_Control
Exit_Here:
    Exit Sub
Err_Control:
    Select Case Err.Number
    'Add your Case selections here
      Case Else
      MsgBox Err.Description
      Err.Clear
      Resume Exit_Here
    End Select
End Sub

MickD 发表于 2007-12-10 18:58:43

不错！我记得这方面的一些东西，但我当时非常生疏，我也认为有一些方法来编写一个“通用”的误差函数-也许就是这样？？
谢谢布里科

Bryco 发表于 2007-12-10 19:22:23

我怀疑兰德尔下线或隐身，在停工一年后，我在任何地方都找不到他。
获得良好错误处理的另一种方法是安装用于VBA的M-Z工具（没有添加的免费软件），您只需单击一个按钮即可添加错误处理程序。
它也可以为属性和其他好东西编写框架。

JohnF 发表于 2007-12-10 21:41:22

非常酷。 将其添加到我的有用内容列表中。

查看完整版本: 使用Acad处理礼仪时出错