web-dev-qa-db-fra.com

Comment obtenir le nom de la procédure ou de la fonction au moment de l'exécution?

Existe-t-il un aucun moyen de renvoyer le nom d'une fonction ou d'une procédure au moment de l'exécution? 

Je gère actuellement quelque chose comme ceci:

Sub foo()
Const proc_name as string = "foo"
On Error GoTo ErrHandler

    ' do stuff

ExitSub:
    Exit Sub
ErrHandler:
    ErrModule.ShowMessageBox "ModuleName",proc_name
    Resume ExitSub
End Sub

J'ai récemment vu une de mes constantes me mentir après avoir mis à jour un nom de fonction, mais pas la valeur constante. Je veux renvoyer le nom de la procédure à mon gestionnaire d'erreurs.

Je sais que je devrai interagir avec l'objet VBIDE.CodeModule pour le trouver. J'ai fait un peu de méta-programmation avec la bibliothèque d'extensibilité de Microsoft Visual Basic pour Applications, mais je n'ai pas réussi à le faire lors de l'exécution. Je n'ai pas mes précédentes tentatives, et avant de me recoucher, je veux savoir si c'est même possible de loin.

Ce qui ne marche pas

  1. Utilisation de la bibliothèque VBA intégrée pour accéder à la pile d’appels. Ça n'existe pas. 
  2. Implémentation de ma propre pile d'appels en poussant et en extrayant les noms de procédure d'un tableau à mesure que j'entre et quitte chacun d'eux. Cela nécessite quand même que je transmette le nom de proc ailleurs sous forme de chaîne. 
  3. Un outil tiers comme vbWatchDog . Ceci fait fonctionne, mais je ne peux pas utiliser un outil tiers pour ce projet. 

Remarque

vbWatchdog semble le faire en accédant directement à la mémoire du noyau via des appels d'API.

vbaerror-handling
15
RubberDuck

J'utilise une classe de pile basée sur des nœuds liés, encapsulée dans une classe singleton, instanciée globalement (via l'attribut) CallStack. Cela me permet de gérer les erreurs comme le suggère David Zemens (en enregistrant le nom de la procédure à chaque fois):

Public Sub SomeFunc()
    On Error Goto ErrHandler
    CallStack.Push "MyClass.SomeFunc"


    '... some code ...

    CallStack.Pop()
    Exit Sub

ErrHandler:
    'Use some Ifs or a Select Case to handle expected errors
    GlobalErrHandler() 'Make a global error handler that logs the entire callstack to a file/the immediate window/a table in Access.

End Sub

Si cela peut être utile pour la discussion, je peux poster le code associé. La classe CallStack a une méthode Peek pour connaître la fonction la plus récemment appelée et une fonction StackTrace pour obtenir une sortie chaîne de la pile entière.

Plus précisément pour répondre à votre question, je me suis toujours intéressé à l’extensibilité de VBA pour ajouter automatiquement le code de traitement des erreurs de la chaudière (comme ci-dessus). Je n'ai jamais eu le temps de le faire, mais je pense que c'est tout à fait possible.

4
Blackhawk

Ce qui suit ne répond pas exactement à ma question, mais résout mon problème. Il devra être exécuté pendant le développement avant la publication de l'application.

Ma solution de contournement repose sur le fait que toutes mes constantes portent le même nom, car j'utilise le code de CPearson pour insérer les constantes dans mes procédures au cours du développement.

La bibliothèque VBIDE ne supporte pas bien les procédures, je les ai donc emballées dans un module de classe nommé vbeProcedure.

' Class: vbeProcedure
' requires Microsoft Visual Basic for Applications Extensibility 5.3 library
' Author: Christopher J. McClellan
' Creative Commons Share Alike and Attribute license
'   http://creativecommons.org/licenses/by-sa/3.0/

Option Compare Database
Option Explicit

Private Const vbeProcedureError As Long = 3500

Private mParentModule As CodeModule
Private isParentModSet As Boolean
Private mName As String
Private isNameSet As Boolean

Public Property Get Name() As String
    If isNameSet Then
        Name = mName
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let Name(ByVal vNewValue As String)
    If Not isNameSet Then
        mName = vNewValue
        isNameSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ParentModule() As CodeModule
    If isParentModSet Then
        Set ParentModule = mParentModule
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ParentModule(ByRef vNewValue As CodeModule)
    If Not isParentModSet Then
        Set mParentModule = vNewValue
        isParentModSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get StartLine() As Long
    If isParentModSet And isNameSet Then
        StartLine = Me.ParentModule.ProcStartLine(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get EndLine() As Long
    If isParentModSet And isNameSet Then
        EndLine = Me.StartLine + Me.CountOfLines
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get CountOfLines() As Long
    If isParentModSet And isNameSet Then
        CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Sub initialize(Name As String, codeMod As CodeModule)
    Me.Name = Name
    Me.ParentModule = codeMod
End Sub

Public Property Get Lines() As String
    If isParentModSet And isNameSet Then
        Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Private Sub RaiseObjectNotIntializedError()
    Err.Raise vbObjectError + vbeProcedureError + 10, CurrentProject.Name & "." & TypeName(Me), "Object Not Initialized"
End Sub

Private Sub RaiseReadOnlyPropertyError()
    Err.Raise vbObjectError + vbeProcedureError + 20, CurrentProject.Name & "." & TypeName(Me), "Property is Read-Only after initialization"
End Sub

Ensuite, j'ai ajouté une fonction à mon module DevUtilities (c'est important plus tard) pour créer un objet vbeProcedure et en renvoyer une collection.

Private Function getProcedures(codeMod As CodeModule) As Collection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Returns collection of all vbeProcedures in a CodeModule      '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim StartLine As Long
    Dim ProcName As String
    Dim lastProcName As String
    Dim procs As New Collection
    Dim proc As vbeProcedure

    Dim i As Long

    ' Skip past any Option statement
    '   and any module-level variable declations.
    StartLine = codeMod.CountOfDeclarationLines + 1

    For i = StartLine To codeMod.CountOfLines
        ' get procedure name
        ProcName = codeMod.ProcOfLine(i, vbext_pk_Proc)
        If Not ProcName = lastProcName Then
            ' create new procedure object
            Set proc = New vbeProcedure
            proc.initialize ProcName, codeMod
            ' add it to collection
            procs.Add proc
            ' reset lastProcName
            lastProcName = ProcName
        End If
    Next i
    Set getProcedures = procs

End Function

Ensuite, je parcoure chaque procédure dans un module de code donné.

Private Sub fixProcNameConstants(codeMod As CodeModule)
    Dim procs As Collection
    Dim proc As vbeProcedure
    Dim i As Long 'line counter

    'getProcName codeMod
    Set procs = getProcedures(codeMod)

    For Each proc In procs
        With proc
            ' skip the proc.StartLine
            For i = .StartLine + 1 To .EndLine
                ' find constant PROC_NAME declaration
                If InStr(1, .ParentModule.Lines(i, 1), "Const PROC_NAME", vbTextCompare) Then
                    'Debug.Print .ParentModule.Lines(i, 1)
                    ' replace this whole line of code with the correct declaration
                    .ParentModule.ReplaceLine i, "Const PROC_NAME As String = " & Chr(34) & .Name & Chr(34)
                    'Debug.Print .ParentModule.Lines(i, 1)
                    Exit For
                End If
            Next i
        End With
    Next proc
End Sub

Enfin, appelez ce sous-traitant pour chaque module de code de mon projet actif (tant que ce n'est pas mon module "DevUtilities").

Public Sub FixAllProcNameConstants()
    Dim prj As vbProject
    Set prj = VBE.ActiveVBProject
    Dim codeMod As CodeModule
    Dim vbComp As VBComponent

    For Each vbComp In prj.VBComponents
        Set codeMod = vbComp.CodeModule
        ' don't mess with the module that'c calling this
        If Not codeMod.Name = "DevUtilities" Then
            fixProcNameConstants codeMod
        End If
    Next vbComp
End Sub

Je reviendrai si je découvre le genre de rituel que vbWatchDog utilise pour exposer la pile d'appels vba.

3
RubberDuck

Utilisez Err.Raise

Pour le paramètre Source, entrez:

Me.Name & "." & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
1
Mark Ronollo