1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
| Option Explicit
'A pour but de récupérer un dictionnaire comportant la liste des membres d'une énumération par exemple Private/Public/__ Enum sont pris en compte.
'Où Key = Valeur / Item = eMembreEnumeration
'@Param strEnumName : Nom de l'énumération à rechercher
'@Param strModuleName : Module qui contient l'énumération (si inconnu, celui-ci cherchera dans tous les modules)
'@Param strProjectName : Nom du Projet (si inconnu, celui-ci cherchera dans tous les projets)
'Resultat : Retourne un objet Dictionnary qui contient la liste des noms de l'énumération passé en paramètre
'Necessite les références :
'Microsoft Visual Basic for Applications Extensibility 5.3
'Microsoft Scripting Runtime
Sub testEnum()
Dim a As Dictionary
Set a = EnumNoms("eMatrix_Operation", "Module1", "Functions VBA Matrice.xlsm")
MsgBox "Teste l'Enum de value 3 est " & a.Item(16)
End Sub
Public Function EnumNoms(ByVal strEnumName As String, Optional ByVal strModuleName As String, Optional ByVal strProjectName As String) As Scripting.Dictionary
Dim objVBProject As VBProject
Dim objVBComponent As VBComponent
Dim objCodeModule As CodeModule
Dim objDictionnary As Scripting.Dictionary
Dim strVBProjectFileName As String
Dim strErrorMessage As String
Dim lngEnumMemberValue As Long
Dim vntSplittedProjectName As Variant
Dim strCodeModule As String
Dim regEnum As RegExp
Dim matchesEnum As MatchCollection
Dim strListEnum As String, vntLigneEnum As Variant, vntCoupleKV As Variant
'Initialisation
lngEnumMemberValue = -1
If strProjectName <> vbNullString Then
vntSplittedProjectName = Split(strProjectName, ".")
strProjectName = vntSplittedProjectName(0)
End If
For Each objVBProject In Application.VBE.VBProjects
If strProjectName <> vbNullString Then
vntSplittedProjectName = Split(objVBProject.Filename, "\") 'Découpe le chemin d'accès du FileName avec le séparateur "\"
vntSplittedProjectName = Split(vntSplittedProjectName(UBound(vntSplittedProjectName)), ".") 'Récupère le nom de fichier en retirant l'extension
strVBProjectFileName = vntSplittedProjectName(0) 'Ecrit le nom de fichier dans la variable pour comparaison avec celui demandé
End If
If strVBProjectFileName = strProjectName Or strProjectName = vbNullString Then 'Si le projet demandé est le même que celui scruté ou si aucun projet n'est spécifié en paramètre
For Each objVBComponent In objVBProject.VBComponents 'Boucle pour chaque Composant du projet VB (Sheets, ThisWorkbook, Userforms, Modules, Modules de classe)
If objVBComponent.Name = strModuleName Or strModuleName = "" Then 'Si le nom de fichier correspond à celui demandé en paramètre ou si rien n'est spécifié en paramètre
Set objCodeModule = objVBComponent.CodeModule 'Permet d'accéder au code contenu dans le composant du projet VB
With objCodeModule
'On instancie la RegExp
Set regEnum = New RegExp
'On parametre
regEnum.Global = True
regEnum.MultiLine = False
regEnum.IgnoreCase = True
'
'On récupère le code du module
strCodeModule = .Lines(1, .CountOfLines)
'On supprime les commentaires
'On teste et on execute la regexp
'Ici la regExp ne cherche pas si ' est dans une zone de chaine
If TestRunRegExp(regEnum, strCodeModule, "((\t| )*REM|')(\s*(.*)(\n(\t| )*?.*( _\n\s*.*))?)", matchesEnum) Then
'On supprime les zones de com
strCodeModule = regEnum.Replace(strCodeModule, vbNullString)
End If
'On recherche notre Enum
If TestRunRegExp(regEnum, strCodeModule, "( |\t)*(Public |Private )?Enum eMatrix_Operation((.|\n)*)(End Enum)+?", matchesEnum) Then
'Logiquement un seul ou pas de résultat
'On prend en compte la liste des enum
'On supprime les tabulations, espaces,chr(10) éventuel(les)
strListEnum = Replace(Replace(Replace(matchesEnum(0).SubMatches(2), Chr(9), vbNullString), " ", vbNullString), Chr(10), "")
'On instancie le dico
Set objDictionnary = New Scripting.Dictionary
'On boucle sur chaque ligne
For Each vntLigneEnum In Split(strListEnum, Chr(13))
If vntLigneEnum <> "" Then
'On découpe pour trouver le couple key / valeur
vntCoupleKV = Split(vntLigneEnum, "=")
If UBound(vntCoupleKV) > 0 Then
'On mémorise la valeur attribuée par le programmeur
vntCoupleKV(1) = Replace(vntCoupleKV(1), """", vbNullString)
lngEnumMemberValue = CLng(vntCoupleKV(1))
Else
'On détermine la valeur attribuée par VB
lngEnumMemberValue = lngEnumMemberValue + 1
End If
'On note le couple dans le dico
If objDictionnary.Exists(lngEnumMemberValue) Then
objDictionnary.Item(lngEnumMemberValue) = Replace(objDictionnary.Item(lngEnumMemberValue), " ou", ",") & " ou " & vntCoupleKV(0)
Else
objDictionnary.Add lngEnumMemberValue, vntCoupleKV(0)
End If
End If
Next
End If
'On sort des boucles
GoTo Fin:
End With
End If
Next
End If
Next
Fin:
If objDictionnary Is Nothing Then
strErrorMessage = "L'enumération passée en paramètre ''strEnumName'' (" & strEnumName & ") n'a pas été trouvé dans "
If strModuleName <> vbNullString Then
strErrorMessage = strErrorMessage & "le module ''" & strModuleName & "''"
Else
strErrorMessage = strErrorMessage & "les modules"
End If
If strProjectName <> vbNullString Then
strErrorMessage = strErrorMessage & " du projet ''" & strProjectName & "''"
Else
strErrorMessage = strErrorMessage & " des projets ouverts."
End If
Err.Raise 515, , strErrorMessage
End If
Set EnumNoms = objDictionnary
End Function
Function TestRunRegExp(aRegExp As RegExp, Text As String, aPattern As String, Matches As MatchCollection) As Boolean
aRegExp.Pattern = aPattern
If aRegExp.Test(Text) Then
'On lance la requête
Set Matches = aRegExp.Execute(Text)
TestRunRegExp = Not Matches Is Nothing
End If
End Function
Sub TestExpReg(texte As String, aRegExp As RegExp, Optional ByRef SupTexte As String)
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection
Dim i As Integer
If aRegExp.Test(texte) Then
Set Matches = aRegExp.Execute(texte)
If Matches.Count = 0 Then
Debug.Print "Aucune occurence trouvée"
ElseIf Matches.Count > 500 Then
Debug.Print "Plus de 500 occurences..."
Else
Debug.Print Matches.Count & " occurence(s) trouvée(s) pour ExpReg: " & aRegExp.Pattern
For Each Match In Matches
Debug.Print "source >>", Match.Value
For i = 0 To Match.SubMatches.Count - 1
Debug.Print "[$" & i + 1 & "]", Match.SubMatches(i)
Next i
If SupTexte <> "" Then SupTexte = Replace(SupTexte, Match.Value, "")
Next Match
Debug.Print Matches.Count & " occurence(s) trouvée(s) pour ExpReg: " & aRegExp.Pattern & vbCrLf
End If
Else
Debug.Print "Pattern introuvable dans la chaine"
End If
End Sub |
[Outil-E] Récupérer le nom des membres d'une énumération
Répondre avec citation
Envoyé par Qwazerty
).
)
Partager