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
Remarque
vbWatchdog semble le faire en accédant directement à la mémoire du noyau via des appels d'API.
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.
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.
Utilisez Err.Raise
Pour le paramètre Source, entrez:
Me.Name & "." & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)