web-dev-qa-db-fra.com

Obtenir le nom de la fonction VBA actuelle

Pour le code de traitement des erreurs, j'aimerais connaître le nom de la fonction (ou sous-charge) VBA actuelle dans laquelle l'erreur s'est produite. Est-ce que quelqu'un sait comment cela peut être fait?

[EDIT] Merci à tous, j'avais espéré qu'un truc non documenté existait pour déterminer la fonction, mais cela n'existe évidemment pas. Je suppose que je vais rester avec mon code actuel:

Option Compare Database: Option Explicit: Const cMODULE$ = "basMisc"

Public Function gfMisc_SomeFunction$(target$)
On Error GoTo err_handler: Const cPROC$ = "gfMisc_SomeFunction"
    ...
exit_handler:
    ....
    Exit Function
err_handler:
    Call gfLog_Error(cMODULE, cPROC, err, err.Description)
    Resume exit_handler
End Function
ms-accessvba
29
maxhugen

Le nom de la fonction actuelle ne contient rien, mais vous pouvez créer un système de traçage relativement léger en utilisant le fait que les durées de vie des objets VBA sont déterministes. Par exemple, vous pouvez avoir une classe appelée 'Tracer' avec ce code:

Private proc_ As String

Public Sub init(proc As String)
    proc_ = proc
End Sub

Private Sub Class_Terminate()
    If Err.Number <> 0 Then
        Debug.Print "unhandled error in " & proc_
    End If
End Sub

puis utilisez cette classe dans des routines comme:

Public Sub sub1()
    Dim t As Tracer: Set t = New Tracer
    Call t.init("sub1")

    On Error GoTo EH

    Call sub2

    Exit Sub

EH:
    Debug.Print "handled error"
    Call Err.Clear
End Sub

Public Sub sub2()
    Dim t As Tracer: Set t = New Tracer
    Call t.init("sub2")

    Call Err.Raise(4242)
End Sub

Si vous exécutez 'sub1', vous devriez obtenir ce résultat:

unhandled error in sub2
handled error

parce que votre instance de Tracer dans 'sub2' a été détruite de manière déterministe lorsque l'erreur a entraîné une sortie de la routine.

Ce modèle général est très courant en C++, sous le nom "RAII", mais il fonctionne également très bien en VBA (à part la gêne généralisée liée à l'utilisation de classes).

MODIFIER:

Pour répondre au commentaire de David Fenton selon lequel il s'agit d'une solution relativement compliquée à un problème simple, je ne pense pas que le problème soit en réalité aussi simple!

Je prends pour acquis que nous convenons tous que nous ne voulons pas attribuer à chaque routine de notre programme VBA son propre gestionnaire d’erreurs. (Voir mon raisonnement ici: Erreur VBA "Bubble Up" )

Si certaines routines internes n'ont pas leurs propres gestionnaires d'erreur, lorsque nous faisons une erreur, tout ce que nous savons, c'est que cela s'est passé dans la routine avec le gestionnaire d'erreur qui s'est déclenché ou dans une routine plus en profondeur dans l'appel empiler. Donc, si je comprends bien, le problème est en réalité un de retracer l'exécution de notre programme. Traçage des entrées de routine est facile bien sûr. Mais tracer la sortie peut en effet être assez compliqué. Par exemple, une erreur peut survenir! 

L’approche RAII nous permet d’utiliser le comportement naturel de la gestion de la vie d’un objet VBA pour reconnaître le moment où nous avons quitté une routine, qu’il s’agisse d’une «sortie», d’une «fin» ou d’une erreur. Mon exemple de jouet est juste destiné à illustrer le concept. Le vrai "traceur" dans mon propre petit framework VBA est certes plus complexe, mais en fait plus:

Private Sub Class_Terminate()
    If unhandledErr_() Then
        Call debugTraceException(callID_, "Err unhandled on exit: " & fmtCurrentErr())
    End If

    If sendEntryExit_ Then
        Select Case exitTraceStatus_
            Case EXIT_UNTRACED
                Call debugTraceExitImplicit(callID_)
            Case EXIT_NO_RETVAL
                Call debugTraceExitExplicit(callID_)
            Case EXIT_WITH_RETVAL
                Call debugTraceExitExplicit(callID_, retval_)
            Case Else
                Call debugBadAssumption(callID_, "unrecognized exit trace status")
        End Select
    End If
End Sub

Mais l’utiliser est quand même assez simple et équivaut à moins que l’approche "EH dans chaque routine":

Public Function apply(functID As String, seqOfArgs)
    Const PROC As String = "apply"
    Dim dbg As FW_Dbg: Set dbg = mkDbg(MODL_, PROC, functID, seqOfArgs)

...

Générer automatiquement le passe-partout est facile, bien que je l’aie saisi puis que je vérifie automatiquement que les noms routine/argument correspondent dans le cadre de mes tests.

15
jtolle

J'utilise le bouton du gestionnaire d'erreurs dans le répertoire libre MZTools for VBA. Il ajoute automatiquement les lignes de code avec le nom de la sous/fonction. Maintenant, si vous renommez la sous/fonction, vous devez vous rappeler de changer le code.

MZTools possède également de nombreuses fonctions Nice. Par exemple, un écran de recherche amélioré et le meilleur de tous est un bouton vous montrant tous les endroits où cette sous/fonction est appelée. 

5
Tony Toews

Ne pas utiliser de manière VBA intégrée. Le mieux que vous puissiez faire est de vous répéter en codant en dur le nom de la méthode en tant que variable constante ou régulière au niveau de la méthode.

Const METHOD_NAME = "GetCustomer"

 On Error Goto ErrHandler:
 ' Code

ErrHandler:
   MsgBox "Err in " & METHOD_NAME

Vous pourrez peut-être trouver quelque chose de pratique dans MZ Tools for VBA . C'est un complément du développeur pour la famille de langues VB. Écrit par un MVP.

3
p.campbell

VBA ne possède aucune trace de pile intégrée à laquelle vous pouvez accéder par programme. Vous devez concevoir votre propre pile et appuyer dessus pour accomplir quelque chose de similaire. Sinon, vous devrez coder en dur vos noms de fonction/sous-nom dans le code.

3
KevenDenen

vbWatchdog est une solution commerciale au problème. Son prix est très raisonnable pour ses capacités. Entre autres fonctionnalités, il offre accès complet à la pile d'appels VBA} _. Je ne connais aucun autre produit qui fasse cela (et j'ai regardé).

Il existe plusieurs autres fonctionnalités, notamment l'inspection variable et les boîtes de dialogue d'erreur personnalisées, mais l'accès à la trace de la pile vaut à lui seul le prix d'une admission.

REMARQUE: je ne suis en aucun cas affilié au produit, sauf que je suis un utilisateur extrêmement satisfait.

2
mwolfe02

Le code de Sean Hendrix n'est pas mal du tout. Je l'ai amélioré un peu:

Public Function AddErrorCode(modName As String)
    Dim VBComp As Object
    Dim VarVBCLine As Long

    Set VBComp = Application.VBE.ActiveVBProject.VBComponents(modName)

    For VarVBCLine = 1 To VBComp.CodeModule.CountOfLines + 1000
        If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Function *") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine + 1, 1) Like "On Error GoTo *") Then
                     VBComp.CodeModule.InsertLines VarVBCLine + 1, "On Error GoTo ErrHandler_"
                     VBComp.CodeModule.InsertLines VarVBCLine + 2, "    Dim VarThisName as String"
                     VBComp.CodeModule.InsertLines VarVBCLine + 3, "    VarThisName = """ & Trim(Mid(VBComp.CodeModule.Lines(VarVBCLine, 1), InStr(1, VBComp.CodeModule.Lines(VarVBCLine, 1), "Function") + Len("Function"), Len(VBComp.CodeModule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 4
            End If
        End If
         If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*End Function*") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine - 1, 1) Like "*Resume '*") And Not (UCase(VBComp.CodeModule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                VBComp.CodeModule.InsertLines VarVBCLine, "ExitProc_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 1, "    Exit Function"
                VBComp.CodeModule.InsertLines VarVBCLine + 2, "ErrHandler_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 3, "    Call LogError(Err, Me.Name, VarThisName)"
                VBComp.CodeModule.InsertLines VarVBCLine + 4, "    Resume ExitProc_"
                VBComp.CodeModule.InsertLines VarVBCLine + 5, "    Resume ' use for debugging"
                VarVBCLine = VarVBCLine + 6
            End If
        End If

        If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Private Sub *") Or UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Public Sub *") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine + 1, 1) Like "On Error GoTo *") Then
                     VBComp.CodeModule.InsertLines VarVBCLine + 1, "On Error GoTo ErrHandler_"
                     VBComp.CodeModule.InsertLines VarVBCLine + 2, "    Dim VarThisName as String"
                     VBComp.CodeModule.InsertLines VarVBCLine + 3, "    VarThisName = """ & Trim(Mid(VBComp.CodeModule.Lines(VarVBCLine, 1), InStr(1, VBComp.CodeModule.Lines(VarVBCLine, 1), "Sub") + Len("Sub"), Len(VBComp.CodeModule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 4
            End If
        End If
         If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*End Sub*") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine - 1, 1) Like "*Resume '*") And Not (UCase(VBComp.CodeModule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                VBComp.CodeModule.InsertLines VarVBCLine, "ExitProc_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 1, "    Exit Sub"
                VBComp.CodeModule.InsertLines VarVBCLine + 2, "ErrHandler_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 3, "    Call LogError(Err, Me.Name, VarThisName)"
                VBComp.CodeModule.InsertLines VarVBCLine + 4, "    Resume ExitProc_"
                VBComp.CodeModule.InsertLines VarVBCLine + 5, "    Resume ' use for debugging"
                'VBComp.CodeModule.DeleteLines VarVBCLine + 5, 1
                'VBComp.CodeModule.ReplaceLine VarVBCLine + 5, "    Resume ' replaced"
                VarVBCLine = VarVBCLine + 6
            End If
        End If

    Next VarVBCLine

End Function

Vous pouvez le mettre dans un module séparé et l'appeler comme suit:

AddErrorCode "Form_MyForm"

dans la fenêtre immédiate. Cela changera votre code de formulaire à partir de ceci:

Private Sub Command1_Click()

    Call DoIt

End Sub

à cela dans toutes les procédures sur de MyForm. 

Private Sub Command1_Click()
On Error GoTo ErrHandler_
   Dim VarThisNameAs String
   VarThisName = "Command1_Click()"

        Call DoIt

ExitProc_:
    Exit Sub
ErrHandler_:
    Call LogError(Err, Me.Name, VarThisName)
    Resume ExitProc_
    Resume ' use for debugging
End Sub

Vous pouvez l'exécuter à plusieurs reprises pour le même formulaire sans dupliquer le code . Vous devez créer un sous-compte public pour intercepter les erreurs et écrire le code dans un fichier ou une base de données pour le consigner.

Public Sub LogError(ByVal objError As ErrObject, PasModuleName As String, Optional PasFunctionName As String = "")
    On Error GoTo ErrHandler_
    Dim sql As String
    ' insert the values into a file or DB here
    MsgBox "Error " & Err.Number & Switch(PasFunctionName <> "", " in " & PasFunctionName) & vbCrLf & " (" & Err.Description & ") ", vbCritical, Application.VBE.ActiveVBProject.Name
Exit_:
    Exit Sub
ErrHandler_:
    MsgBox "Error in LogError function " & Err.Number
    Resume Exit_
    Resume ' use for debugging
End Sub
1
Vlado

Cela fonctionne pour moi. Je suis en 2010. 

ErrorHandler:
    Dim procName As String
    procName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MyErrorHandler err, Me.Name, getUserID(), procName
    Resume Exithere
1
Randall Porter

Le code est moche mais ça marche. Cet exemple ajoutera un code de traitement des erreurs à chaque fonction contenant également une chaîne portant le nom de la fonction. 

Function AddErrorCode()
    Set vbc = ThisWorkbook.VBProject.VBComponents("Module1")
    For VarVBCLine = 1 To vbc.codemodule.CountOfLines + 1000
        If UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*Function *") And Not (UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*Function FunctionReThrowError*")) Then
            If Not (vbc.codemodule.Lines(VarVBCLine + 1, 1) Like "*Dim VarFunctionName As String*") Then
                     vbc.codemodule.InsertLines VarVBCLine + 1, "Dim VarFunctionName as String"
                     vbc.codemodule.InsertLines VarVBCLine + 2, "VarFunctionName = """ & Trim(Mid(vbc.codemodule.Lines(VarVBCLine, 1), InStr(1, vbc.codemodule.Lines(VarVBCLine, 1), "Function") + Len("Function"), Len(vbc.codemodule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 3
            End If
        End If
         If UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*End Function*") Then
            If Not (vbc.codemodule.Lines(VarVBCLine - 1, 1) Like "*Call FunctionReThrowError(Err, VarFunctionName)*") And Not (UCase(vbc.codemodule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                vbc.codemodule.InsertLines VarVBCLine, "ErrHandler:"
                vbc.codemodule.InsertLines VarVBCLine + 1, "Call FunctionReThrowError(Err, VarFunctionName)"
                VarVBCLine = VarVBCLine + 2
            End If
        End If
    Next VarVBCLine
   If Not (vbc.codemodule.Lines(1, 1) Like "*Function FunctionReThrowError(ByVal objError As ErrObject, PasFunctionName)*") Then
        vbc.codemodule.InsertLines 1, "Function FunctionReThrowError(ByVal objError As ErrObject, PasFunctionName)"
        vbc.codemodule.InsertLines 2, "Debug.Print PasFunctionName & objError.Description"
        vbc.codemodule.InsertLines 3, "Err.Raise objError.Number, objError.Source, objError.Description, objError.HelpFile, objError.HelpContext"
        vbc.codemodule.InsertLines 4, "End Function"
    End If
End Function
0
sean hendrix