Soyez le premier à donner votre avis sur cette source.
Vue 4 196 fois - Téléchargée 283 fois
'|--------------------------------------------------------------- '| module : basDebugPiste '|--------------------------------------------------------------- '| Description : Fonctions de suivit d'erreurs '| '| Contenu : '|--------------------------------------------------------------- '| 1> Push(ByVal strNomProc As gudtSuivit) '| '| Remplissage du tableau '| Cette SubRoutine doit etre appelee '| au début de chaques fonction ou Sub '| '| on doit lui fournir un objet de type gudtSuivit '| comportant : '| .NomModule '| .NomFonction '|--------------------------------------------------------------- '| 2> Pop() '| '|on vide le tableau '| '| Doit etre présent en fin de fonction ou '| SubRoutine '|---------------------------------------------------------------- '| 3> Public Sub AfficheErreur(ByVal NumErreur As String, _ '| ByVal DescriptionErreur As String, _ '| Optional ByVal FichierErreur As String) '| '| affichage des informations concernant l'erreur '| '| Valeurs a fournir : '| NumErreur Le N° de l'erreur (err.Number) '| DescriptionErreur La description de l'erreur (err.description) '| Optionel : '| Un fichier d'erreur A decrire depuis la racine (ex : "C:\lulu\Erreur.log" ) '| Si le fichier n'existe pas -> Il est cree '| Le fichier est mis en lecture seule (pas de manips manuelles) '| Pas de test d'existence du répertoire -> le créer au préalable '| -> sinon pb (vrai aussi pour un disque <>) '|--------------------------------------------------------------------- '| Utilisation : '| '| --------------------------------------------------- '| Lors de ma mise en place d'un programme '| il faut initialiser la variable publique '| glngIndex a -1 (pour Form_load ou Sub main) '| --------------------------------------------------- '| '| Private Sub Form_Load() '| '| initialisation de la variable erreur '| Dim Erreur As gudtSuivit '| on met l'index du tableau a -1 '| glngIndex = -1 '| With Erreur '| .NomModule = "frmDebug" '| .NomFonction = "Form_Load" '| End With '| '| on rempli le tableau '| Push Erreur '| '| Si une erreur se produit : '| On Error GoTo etqErreur '| '| Bla bla ..... le programme '| avoir 'une SubRoutine '| Bla bla..... '| '| sortie de la subroutine '| etqSortie: '| Pop 'on vide le tableau d'un élément '| Exit Sub 'on sort '|---- '| etqErreur: 'les erreurs sont traitées Ici '| utilisation du suivit d'erreurs '| AfficheErreur Err.Number, Err.Description '| GoTo etqSortie 'on sort par etqSortie '| '| End Sub ' fin de form_load '| ---------------------------------------------------------------- '| pour une fonction ou SubRoutine Lamba..... '| '| public sub (ou function) avoir() '| '| Dim lulu as gudtSuivit '| with lulu '| .NomModule = "Nom du fichier intégrant avoir" '| .NomFonction = "avoir" '| End With '| Push lulu '| '| on error goto etqErreur '| '| Blabla....................... '| '| etqSortie: '| pop '| exit sub (ou exit function) '| '| etqErreur: '| AfficheErreur Err.Number, Err.Description '| GoTo etqSortie 'on sort par etqSortie '| '| end sub (ou end function) '|--------------------------------------------------------------------- '| Eléments(s) utilisé(s) par ce module : Bib/Fichiers/F_Fich_Dir.bas '| '|--------------------------------------------------------------------- '| Versions : '| '| jim le : 25/09/2002 origine '| '|#-------------------------------------------------------------------- Option Explicit '---------------------------------------------------------------- ' Objet de suivit ' NomModule : Nom du fichier ou se trouve la fonction ' ou la SubRoutine ' NomFonction : Nom de la fonction ou subroutine '---------------------------------------------------------------- Public Type gudtSuivit NomModule As String NomFonction As String End Type '---------------------------------------------------------------- Public gpstrTabTrace() As gudtSuivit 'Le tableau du suivit Public glngIndex As Long 'Index du tableau '---------------------------------------------------------------- '---------------------------------------------------------------- 'Remplissage du tableau ' Cette SubRoutine doit etre appelee ' au début de chaques fonction ou Sub ' ' on doit lui fournir un objet de type gudtSuivit ' comportant : ' .NomModule ' .NomFonction '---------------------------------------------------------------- Public Sub Push(strNomProc As gudtSuivit) 'On ajoute un case au tableau '----------------------------------- glngIndex = glngIndex + 1 ReDim Preserve gpstrTabTrace(glngIndex) 'On lui affecte le nom de la fonction ou la proc en cours '--------------------------------------------------------- gpstrTabTrace(glngIndex) = strNomProc End Sub '--------------------------------------------------------------- 'on vide le tableau ' ' Doit etre présent en fin de fonction ou ' SubRoutine '---------------------------------------------------------------- Public Sub Pop() 'on vide la derniere case du tableau 'si on est pas sur la derniere case '-------------------------------------------- If UBound(gpstrTabTrace) <> 0 Then ReDim Preserve gpstrTabTrace(UBound(gpstrTabTrace) - 1) glngIndex = glngIndex - 1 Else 'sinon on vide le fichier Erase gpstrTabTrace glngIndex = -1 End If End Sub '---------------------------------------------------------------------------- 'affichage des informations concernant l'erreur ' ' Valeurs a fournir : ' NumErreur Le N° de l'erreur (err.Number) ' DescriptionErreur La description de l'erreur (err.description) ' Optionel : ' Un fichier d'erreur A decrire depuis la racine (ex : "C:\lulu\Erreur.log" ) ' Si le fichier n'existe pas -> Il est cree ' Le fichier est mis en lecture seule (pas de manips manuelles) '---------------------------------------------------------------------------- Public Sub AfficheErreur(ByVal NumErreur As String, _ ByVal DescriptionErreur As String, _ Optional ByVal FichierErreur As String) '-------------------------------------------- Dim strMsgErreur As String 'le message a afficher Dim i As Long 'un compteur Dim retour As Boolean 'pour test d'existence du fichier d'erreurs Dim xlog As Long 'Num du fichier erreur strMsgErreur = "" xlog = FreeFile '------------------------------------------- strMsgErreur = "--------------------------------------------" + vbCrLf _ + "Erreur N° " & NumErreur + vbCrLf _ + DescriptionErreur + vbCrLf _ + "--------------------------------------------" + vbCrLf '-------------------------------------------------- 'affichage des différentes procédures actives 'en partant de la derniere en cours '-------------------------------------------------- For i = UBound(gpstrTabTrace) To 0 Step -1 strMsgErreur = strMsgErreur & _ "Module : " & gpstrTabTrace(i).NomModule & " " & " <-> " & _ "Fonction : " & gpstrTabTrace(i).NomFonction & vbCrLf Next i 'affichage de la boite de message '--------------------------------------- MsgBox strMsgErreur '--------------------------------------- 'Fichier d'erreur '--------------------------------------- 'si le parametre existe If FichierErreur <> "" Then 'on teste s'il existe déjà retour = Test_Fichier(FichierErreur) '-> voir module F_Fich_Dir.bas 'integrer la fonction fso pour etre autonome If retour = False Then 'il n'existe pas Open FichierErreur For Output As xlog Print #xlog, "--------------------------------------------" Print #xlog, " Le : " & Date & " a " & Time Print #xlog, strMsgErreur Close #xlog SetAttr FichierErreur, vbReadOnly Else 'il existe 'Append SetAttr FichierErreur, vbNormal Open FichierErreur For Append As xlog Print #xlog, "--------------------------------------------" Print #xlog, " Le : " & Date & " a " & Time Print #xlog, strMsgErreur Close #xlog SetAttr FichierErreur, vbReadOnly End If End If End Sub
4 oct. 2003 à 16:35
pour générer une erreur utilisateur :
Err.raise NumUserErreur
err.description UserDescription
Y a plus qu'à tester l'objet pour savoir si il y a eu une erreur rattrappée par un sub ou une classe
if err.number <> 0 then
msgbox err.description
end if
3 nov. 2002 à 18:51
http://www.vbfrance.com/article.aspx?Val=6233
DARK SIDIOUS
3 nov. 2002 à 18:00
DARK SIDIOUS
30 sept. 2002 à 19:30
A+
Spip
30 sept. 2002 à 10:43
Quand a DarkSiDious, as tu eu le temps de faire ta DLL ??????
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.