2013-02-18 3 views
3

Есть ли способ сделать глобальную обработку ошибок?Excel VBA Глобальная обработка ошибок

Могу ли я поместить код в код рабочей книги, который поймает любые ошибки, возникающие во всех модулях?

Я мог бы поместить тот же обработчик ошибок в каждый модуль, но я ищу что-то более общее.

Я спрашиваю, потому что у меня есть имена листов, которые хранятся в виде глобальных переменных, таких как Sheets(QuoteName). Если есть ошибка, эти глобальные переменные теряются. У меня есть макрос, который переименует глобальные переменные, но я помещаю это в Workbook_BeforeSave.

Я хочу, чтобы перейти к глобальному обработчику ошибок и переименовывать глобальные переменный, если я получаю Подстрочные из ошибки диапазона для Sheets(QuoteName)

+1

AFAIK. Вы не можете достичь такого рода обработки ошибок. В каждой процедуре вам необходимо индивидуально включить «On Error Goto». –

+0

Хорошо. Это позор. Сохранила бы меня некоторое время. – evoandy

ответ

7

Как Sid уже упоминался в комментариях, нет центрального обработчика ошибок ,

Лучшей практикой является использование стандартной процедуры обработки ошибок, вызываемой из локальных обработчиков ошибок. Взгляните на отличный MZ-Tools: он имеет возможность определять обработчик ошибок по умолчанию при нажатии кнопки (Ctrl - E). Вы можете настроить этот обработчик ошибок - и он также может содержать имя модуля и/или подменю!

Кроме того, ознакомьтесь с этим постом в Daily Dose of Excel. Это версия OO Dick Kusleika для обработчика ошибок, предложенная в this book (которую я очень рекомендую).

+0

+1 - MZ-Tools - отличная надстройка. – Buggabill

+1

Действительно, MZ-Tools - неоценимое дополнение к инструментарию VBA. В сочетании с автоматической функцией нумерации строк инструмент для установки процедуры обработки ошибок отлично подходит для представления необработанных исключений во время бета/UAT-фаз крупных проектов. С небольшими усилиями вы можете построить иерархию, с помощью которой любая необработанная ошибка времени выполнения может быть передана обратно в точку ввода макроса и отправлена ​​через пользовательский файл формы/журнала в комплекте с историей вызовов процедур со всеми номерами строк точки выхода. – blackworx

-2

Вот код, я бросил вместе, чтобы справиться с проблемой доступа

Это ставит проверку ошибок во всех подлодках, но не функции. subs должны иметь родительскую форму (ACCESS), или, альтернативно, вы должны поместить имя формы вручную. подводные лодки, которые продолжаются более чем на одной линии, будут беспощадно удалены.

Эти два устройства должны находиться в нижней части модуля.

  • globalerror ваше управление ошибками рутина
  • CleaVBA_click изменяет свой код VBA, добавляет линии #s ко всему

globalerror смотрит на булевой глобальной errortracking, чтобы увидеть, если он регистрирует все или только ошибки

Существует таблица ErrorTracking, которая должна быть cr eated иначе просто закомментировать с 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 
Смежные вопросы