Solución:
Tiene una respuesta verdaderamente maravillosa de ray023, pero su comentario de que probablemente sea excesivo es adecuado. Para una versión “más ligera” …
Bloque 1 es, en mi humilde opinión, una mala práctica. Como ya ha señalado osknows, mezclar el manejo de errores con el código de ruta normal no es bueno. Por un lado, si un nuevo se produce un error mientras hay una condición de error en efecto, no tenga la oportunidad de manejarlo (a menos que esté llamando desde una rutina que también tiene un controlador de errores, donde la ejecución “burbujeará”).
Bloque 2 parece una imitación de un bloque Try / Catch. Debería estar bien, pero no es The VBA Way. Bloque 3 es una variación del Bloque 2.
Bloque 4 es una versión básica de The VBA Way. me gustaría fuertemente Aconseje usarlo, o algo parecido, porque es lo que esperará cualquier otro programador de VBA que herede el código. Sin embargo, permítanme presentarles una pequeña expansión:
Private Sub DoSomething()
On Error GoTo ErrHandler
'Dim as required
'functional code that might throw errors
ExitSub:
'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
'don't forget to do this -- you don't want to fall into error handling when there's no error
Exit Sub
ErrHandler:
'can Select Case on Err.Number if there are any you want to handle specially
'display to user
MsgBox "Something's wrong: " & vbCrLf & Err.Description
'or use a central DisplayErr routine, written Public in a Module
DisplayErr Err.Number, Err.Description
Resume ExitSub
Resume
End Sub
Tenga en cuenta que el segundo Resume. Este es un truco que aprendí recientemente: Nunca ejecutar en el procesamiento normal, ya que el Resume declaración enviará la ejecución a otra parte. Sin embargo, puede ser una bendición para la depuración. Cuando reciba una notificación de error, elija Depurar (o presione Ctl-Break, luego elija Depurar cuando reciba el mensaje “La ejecución fue interrumpida”). La siguiente declaración (resaltada) será la MsgBox o la siguiente declaración. Utilice “Establecer siguiente declaración” (Ctl-F9) para resaltar el Resume, luego presione F8. Esto te mostrará exactamente donde se lanzó el error.
En cuanto a su objeción a que este formato “salte”, A) es lo que esperan los programadores de VBA, como se indicó anteriormente, & B) sus rutinas deberían Sea lo suficientemente corto para que no sea muy largo para saltar.
Dos propósitos principales para el manejo de errores:
- Capture errores que puede predecir pero que no puede controlar el usuario (por ejemplo, guardar un archivo en una memoria USB cuando se han eliminado las memorias USB)
- Para errores inesperados, presente al usuario un formulario que le informe cuál es el problema. De esa manera, pueden transmitirle ese mensaje y es posible que pueda darles una solución mientras trabaja en una solución.
Entonces, ¿cómo harías esto?
En primer lugar, cree un formulario de error para mostrar cuando se produzca un error inesperado.
Podría verse algo como esto (FYI: el mío se llama frmErrors):
Observe las siguientes etiquetas:
- lblHeadline
- lblSource
- lblProblem
- lblResponse
Además, los botones de comando estándar:
- Ignorar
- Rever
- Cancelar
No hay nada espectacular en el código de este formulario:
Option Explicit
Private Sub cmdCancel_Click()
Me.Tag = CMD_CANCEL
Me.Hide
End Sub
Private Sub cmdIgnore_Click()
Me.Tag = CMD_IGNORE
Me.Hide
End Sub
Private Sub cmdRetry_Click()
Me.Tag = CMD_RETRY
Me.Hide
End Sub
Private Sub UserForm_Initialize()
Me.lblErrorTitle.Caption = "Custom Error Title Caption String"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Prevent user from closing with the Close box in the title bar.
If CloseMode <> 1 Then
cmdCancel_Click
End If
End Sub
Básicamente, desea saber qué botón presionó el usuario cuando se cierra el formulario.
A continuación, cree un módulo controlador de errores que se utilizará en toda su aplicación VBA:
'****************************************************************
' MODULE: ErrorHandler
'
' PURPOSE: A VBA Error Handling routine to handle
' any unexpected errors
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/22/2010 Ray Initial Creation
'****************************************************************
Option Explicit
Global Const CMD_RETRY = 0
Global Const CMD_IGNORE = 1
Global Const CMD_CANCEL = 2
Global Const CMD_CONTINUE = 3
Type ErrorType
iErrNum As Long
sHeadline As String
sProblemMsg As String
sResponseMsg As String
sErrorSource As String
sErrorDescription As String
iBtnCap(3) As Integer
iBitmap As Integer
End Type
Global gEStruc As ErrorType
Sub EmptyErrStruc_S(utEStruc As ErrorType)
Dim i As Integer
utEStruc.iErrNum = 0
utEStruc.sHeadline = ""
utEStruc.sProblemMsg = ""
utEStruc.sResponseMsg = ""
utEStruc.sErrorSource = ""
For i = 0 To 2
utEStruc.iBtnCap(i) = -1
Next
utEStruc.iBitmap = 1
End Sub
Function FillErrorStruct_F(EStruc As ErrorType) As Boolean
'Must save error text before starting new error handler
'in case we need it later
EStruc.sProblemMsg = Error(EStruc.iErrNum)
On Error GoTo vbDefaultFill
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum)
EStruc.sProblemMsg = EStruc.sErrorDescription
EStruc.sErrorSource = EStruc.sErrorSource
EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum) & ". You should write down the program function you were using, the record you were working with, and what you were doing."
Select Case EStruc.iErrNum
'Case Error number here
'not sure what numeric errors user will ecounter, but can be implemented here
'e.g.
'EStruc.sHeadline = "Error 3265"
'EStruc.sResponseMsg = "Contact tech support. Tell them what you were doing in the program."
Case Else
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": " & EStruc.sErrorDescription
EStruc.sProblemMsg = EStruc.sErrorDescription
End Select
GoTo FillStrucEnd
vbDefaultFill:
'Error Not on file
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": Contact Tech Support"
EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum)
FillStrucEnd:
Exit Function
End Function
Function iErrorHandler_F(utEStruc As ErrorType) As Integer
Static sCaption(3) As String
Dim i As Integer
Dim iMCursor As Integer
Beep
'Setup static array
If Len(sCaption(0)) < 1 Then
sCaption(CMD_IGNORE) = "&Ignore"
sCaption(CMD_RETRY) = "&Retry"
sCaption(CMD_CANCEL) = "&Cancel"
sCaption(CMD_CONTINUE) = "Continue"
End If
Load frmErrors
'Did caller pass error info? If not fill struc with the needed info
If Len(utEStruc.sHeadline) < 1 Then
i = FillErrorStruct_F(utEStruc)
End If
frmErrors!lblHeadline.Caption = utEStruc.sHeadline
frmErrors!lblProblem.Caption = utEStruc.sProblemMsg
frmErrors!lblSource.Caption = utEStruc.sErrorSource
frmErrors!lblResponse.Caption = utEStruc.sResponseMsg
frmErrors.Show
iErrorHandler_F = frmErrors.Tag ' Save user response
Unload frmErrors ' Unload and release form
EmptyErrStruc_S utEStruc ' Release memory
End Function
Es posible que tenga errores que se personalizarán solo para su aplicación. Por lo general, esta sería una lista breve de errores específicamente solo para su aplicación. Si aún no tiene un módulo de constantes, cree uno que contenga un ENUM de sus errores personalizados. (NOTA: Office '97 NO admite ENUMS). El ENUM debería verse así:
Public Enum CustomErrorName
MaskedFilterNotSupported
InvalidMonthNumber
End Enum
Crea un módulo que arroje tus errores personalizados.
'********************************************************************************************************************************
' MODULE: CustomErrorList
'
' PURPOSE: For trapping custom errors applicable to this application
'
'INSTRUCTIONS: To use this module to create your own custom error:
' 1. Add the Name of the Error to the CustomErrorName Enum
' 2. Add a Case Statement to the raiseCustomError Sub
' 3. Call the raiseCustomError Sub in the routine you may see the custom error
' 4. Make sure the routine you call the raiseCustomError has error handling in it
'
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010 Ray Initial Creation
'********************************************************************************************************************************
Option Explicit
Const MICROSOFT_OFFSET = 512 'Microsoft reserves error values between vbObjectError and vbObjectError + 512
'************************************************************************************************
' FUNCTION: raiseCustomError
'
' PURPOSE: Raises a custom error based on the information passed
'
'PARAMETERS: customError - An integer of type CustomErrorName Enum that defines the custom error
' errorSource - The place the error came from
'
' Returns: The ASCII vaule that should be used for the Keypress
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010 Ray Initial Creation
'************************************************************************************************
Public Sub raiseCustomError(customError As Integer, Optional errorSource As String = "")
Dim errorLong As Long
Dim errorDescription As String
errorLong = vbObjectError + MICROSOFT_OFFSET + customError
Select Case customError
Case CustomErrorName.MaskedFilterNotSupported
errorDescription = "The mask filter passed is not supported"
Case CustomErrorName.InvalidMonthNumber
errorDescription = "Invalid Month Number Passed"
Case Else
errorDescription = "The custom error raised is unknown."
End Select
Err.Raise errorLong, errorSource, errorDescription
End Sub
Ahora está bien equipado para atrapar errores en su programa. Su sub (o función), debería verse así:
Public Sub MySub(monthNumber as Integer)
On Error GoTo eh
Dim sheetWorkSheet As Worksheet
'Run Some code here
'************************************************
'* OPTIONAL BLOCK 1: Look for a specific error
'************************************************
'Temporarily Turn off Error Handling so that you can check for specific error
On Error Resume Next
'Do some code where you might expect an error. Example below:
Const ERR_SHEET_NOT_FOUND = 9 'This error number is actually subscript out of range, but for this example means the worksheet was not found
Set sheetWorkSheet = Sheets("January")
'Now see if the expected error exists
If Err.Number = ERR_SHEET_NOT_FOUND Then
MsgBox "Hey! The January worksheet is missing. You need to recreate it."
Exit Sub
ElseIf Err.Number <> 0 Then
'Uh oh...there was an error we did not expect so just run basic error handling
GoTo eh
End If
'Finished with predictable errors, turn basic error handling back on:
On Error GoTo eh
'**********************************************************************************
'* End of OPTIONAL BLOCK 1
'**********************************************************************************
'**********************************************************************************
'* OPTIONAL BLOCK 2: Raise (a.k.a. "Throw") a Custom Error if applicable
'**********************************************************************************
If not (monthNumber >=1 and monthnumber <=12) then
raiseCustomError CustomErrorName.InvalidMonthNumber, "My Sub"
end if
'**********************************************************************************
'* End of OPTIONAL BLOCK 2
'**********************************************************************************
'Rest of code in your sub
goto sub_exit
eh:
gEStruc.iErrNum = Err.Number
gEStruc.sErrorDescription = Err.Description
gEStruc.sErrorSource = Err.Source
m_rc = iErrorHandler_F(gEStruc)
If m_rc = CMD_RETRY Then
Resume
End If
sub_exit:
'Any final processing you want to do.
'Be careful with what you put here because if it errors out, the error rolls up. This can be difficult to debug; especially if calling routine has no error handling.
Exit Sub 'I was told a long time ago (10+ years) that exit sub was better than end sub...I can't tell you why, so you may not want to put in this line of code. It's habit I can't break :P
End Sub
Es posible que copiar / pegar el código anterior no funcione desde el principio, pero definitivamente debería darle la esencia.
Por cierto, si alguna vez me necesita para hacer el logotipo de su empresa, búsqueme en http://www.MySuperCrappyLogoLabels99.com
Definitivamente no usaría Block1. No parece correcto tener el bloque Error en una declaración IF no relacionada con Errores.
Los bloques 2, 3 y 4 supongo que son variaciones de un tema. Prefiero el uso de los Bloques 3 y 4 en lugar de 2 solo porque no me gusta la declaración GOTO; Generalmente uso el método Block4. Este es un ejemplo de código que utilizo para verificar si se agregó la biblioteca Microsoft ActiveX Data Objects 2.8 y, si no, agregar o usar una versión anterior si la 2.8 no está disponible.
Option Explicit
Public booRefAdded As Boolean 'one time check for references
Public Sub Add_References()
Dim lngDLLmsadoFIND As Long
If Not booRefAdded Then
lngDLLmsadoFIND = 28 ' load msado28.tlb, if cannot find step down versions until found
On Error GoTo RefErr:
'Add Microsoft ActiveX Data Objects 2.8
Application.VBE.ActiveVBProject.references.AddFromFile _
Environ("CommonProgramFiles") + "Systemadomsado" & lngDLLmsadoFIND & ".tlb"
On Error GoTo 0
Exit Sub
RefErr:
Select Case Err.Number
Case 0
'no error
Case 1004
'Enable Trust Centre Settings
MsgBox ("Certain VBA References are not available, to allow access follow these steps" & Chr(10) & _
"Goto Excel Options/Trust Centre/Trust Centre Security/Macro Settings" & Chr(10) & _
"1. Tick - 'Disable all macros with notification'" & Chr(10) & _
"2. Tick - 'Trust access to the VBA project objects model'")
End
Case 32813
'Err.Number 32813 means reference already added
Case 48
'Reference doesn't exist
If lngDLLmsadoFIND = 0 Then
MsgBox ("Cannot Find Required Reference")
End
Else
For lngDLLmsadoFIND = lngDLLmsadoFIND - 1 To 0 Step -1
Resume
Next lngDLLmsadoFIND
End If
Case Else
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
End
End Select
On Error GoTo 0
End If
booRefAdded = TRUE
End Sub
Te invitamos a amparar nuestro cometido fijando un comentario o valorándolo te lo agradecemos.