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

Est-il tout façon de retourner le nom d'une fonction ou d'une procédure au moment de l'exécution?

Je suis actuellement à la gestion des erreurs 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 vécu une de mes constantes mentir à moi après que j'ai mis à jour le nom d'une fonction, mais pas la valeur de la constante. Je veux retourner le nom de la procédure à mon gestionnaire d'erreur.

Je sais que je vais avoir à interagir avec les VBIDE.CodeModule objet à trouver. J'ai fait un peu de méta-programmation avec Microsoft Visual Basic pour Applications la bibliothèque, mais je n'ai pas eu de succès avec cette lors de l'exécution. Je n'ai pas mes précédentes tentatives, et avant que je creuse mes talons pour essayer encore une fois, je veux savoir si c'est même à distance possible.

Choses qui ne fonctionnent pas

  1. À l'aide de certains VBA intégré de la Bibliothèque pour accéder à la pile d'appel. Il n'existe pas.
  2. Mettre mon propre pile d'appel, en poussant et en sautant le nom d'une procédure à partir d'un tableau que je suis entrée et de sortie de chacun. Il faut quand même que je passe le proc nom d'ailleurs, comme une chaîne de caractères.
  3. Un outil tiers comme vbWatchDog. Cette ne travail, mais je ne peux pas utiliser un outil tiers pour ce projet.

Note

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

source d'informationauteur RubberDuck

  1. 4

    Je ne suis pas tout à fait sûr de savoir comment cela est utile va être...

    La bonne chose est que vous n'aurez pas à vous soucier de la sub/nom de la fonction - vous êtes libre de le modifier. Tout ce que vous avez des soins à ce sujet est la de l'unicité du gestionnaire d'erreur, le nom de l'étiquette.

    Par exemple

    si vous pouvez éviter une double erreur de gestionnaire d'étiquettes dans les différentes sous-marins/fonctions

    ne pas faire ⇩⇩⇩⇩⇩

    Sub Main()
    On Error GoTo ErrHandler
    Debug.Print 1 / 0

ErrHandler:
    Debug.Print "handling error in Main"
    SubMain
End Sub

Sub SubMain()
    On Error GoTo ErrHandler
    Debug.Print 1 / 0

ErrHandler:
    Debug.Print "handling error in SubMain"
End Sub

    puis le code ci-dessous devrait travail.

    Note: je n'ai pas pu le tester à fond, mais je suis sûr que vous pouvez le modifier et le faire fonctionner si elle est d'aucun secours.

    Remarque: Ajouter des références à Visual Basic for Applications Extensibility 5.3 via Outils -> Références dans VBE

    Sub Main()
' additionally, this is what else you should do:
' write a Boolean function that checks if there are no duplicate error handler labels
' this will ensure you don't get a wrong sub/fn name returned
Foo
Boo
End Sub
Function Foo()
' remember to set the label name (handlerLabel) in the handler
' each handler label should be unique to avoid errors
On Error GoTo FooErr
Cells(0, 1) = vbNullString ' cause error deliberately
FooErr:
Dim handlerLabel$
handlerLabel = "FooErr" ' or don't dim this and pass the errHandler name directly to the GetFnOrSubName function
Debug.Print "Error occured in " & Application.VBE.ActiveCodePane.CodeModule.Name & ": " & GetFnOrSubName(handlerLabel)
End Function
Sub Boo()
On Error GoTo BooErr
Cells(0, 1) = vbNullString ' cause error deliberately
BooErr:
Debug.Print "Error occured in " & Application.VBE.ActiveCodePane.CodeModule.Name & ": " & GetFnOrSubName("BooErr")
End Sub
' returns CodeModule reference needed in the GetFnOrSubName fn
Private Function GetCodeModule(codeModuleName As String) As VBIDE.CodeModule
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents(codeModuleName)
Set GetCodeModule = VBComp.CodeModule
End Function
' returns the name of the sub where the error occured
Private Function GetFnOrSubName$(handlerLabel$)
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents(Application.VBE.ActiveCodePane.CodeModule.Name)
Set CodeMod = VBComp.CodeModule
Dim code$
code = CodeMod.Lines(1, CodeMod.CountOfLines)
Dim handlerAt&
handlerAt = InStr(1, code, handlerLabel, vbTextCompare)
If handlerAt Then
Dim isFunction&
Dim isSub&
isFunction = InStrRev(Mid$(code, 1, handlerAt), "Function", -1, vbTextCompare)
isSub = InStrRev(Mid$(code, 1, handlerAt), "Sub", -1, vbTextCompare)
If isFunction > isSub Then
' it's a function
GetFnOrSubName = Split(Mid$(code, isFunction, 40), "(")(0)
Else
' it's a sub
GetFnOrSubName = Split(Mid$(code, isSub, 40), "(")(0)
End If
End If
End Function
  2. 4

    - Je utiliser lié nœud en fonction de la pile de la classe enveloppé dans un singleton, à l'échelle mondiale instanciées (fait par des Attributs) CallStack classe. Il me permet d'effectuer la gestion d'erreur comme David Zemens suggère (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

    S'il serait utile à la discussion, je peux poster le code associé. La Pile des appels de classe a un Peek méthode pour trouver le plus récemment fonction appelée est et un StackTrace fonction pour obtenir une chaîne de caractères en sortie de l'ensemble de la pile.

    Plus précisément à votre question, j'ai toujours été intéressé dans l'aide de VBA Extensibilité pour ajouter de la chaudière-plaque de code de gestion d'erreur (comme ci-dessus) automatiquement. Je n'ai jamais eu l'occasion de le faire réellement, mais je crois que c'est tout à fait possible.

  3. 1

    Utilisation Err.Soulever

    Pour le paramètre Source pass:

    Me.Name & "." & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
  4. -2

    Ajouter cette fonction dans n'importe quel module que vous aimez:

    Function getModule_Func_Name()
Dim strModule, strFunction
strModule = Application.VBE.ActiveCodePane.CodeModule
'   getProcedures (Application.VBE.ActiveCodePane.CodeModule)
strFunction = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
getModule_Func_Name = strModule & " , " & strFunction & "()"
End Function

    Et puis dans votre sub/function utiliser comme Err Gestionnaire:

    ErrHandler:
ErrModule.ShowMessageBox getModule_Func_Name
Resume ExitSub