Accueil > > > DÉTECTEUR DE PROCÉDURES ET FONCTIONS INUTILISÉES
DÉTECTEUR DE PROCÉDURES ET FONCTIONS INUTILISÉES
Information sur la source
Description
Cette fonction permet de déterminer pour chaque module les procédures et fonctions qui ne sont pas appelées à partir des formulaires et états et/ou des autres modules dans une base Access Pré-requis : - Il faut que le fichier à vérifier soit un mdb - Dans la base à vérifier référencer la bibliothèque "Visual Basic for Applications Extensibility 5.3" - Importer la table "TR_ObjetNonTrouve" - Importer la macro "Rechercher les objets inutiles dans la base" - Importer le module "RechercheObjetDansBase" - Lancer la macro "Rechercher les objets inutiles dans la base" Les résultats seront inscrits dans la table "TR_ObjetNonTrouve"
Source
- Public Function RechercheFonctionDansModule()
- 'Cette fonction permet de savoir si des fonctions sont utilisées ou non
- Dim Momo1 As Module, Momo2 As Module, Nom_Fx As String, Cur_Ligne As Long, Ligne_en_cours As String, Lignes_Fx As Long, Drapeau_Fx As Boolean
- Dim Forme As Form, Etat As Report, Reponse As Byte
- Dim Fx() As String, a As Integer, b As Integer, c As Long, d As Long
- 'FX permet d'énumérer le nom des fonctions et procédures des modules.
- 'Sa structure est la suivante
- 'La première dimension indique le nom de la fonction ou procédure
- 'La seconde le nom du module et de la fonction
- 'La troisième si celle-ci a été trouvée dans un autre module
- 'Exemple Fx(0,0)="Florent":Fx(1,0)=False
-
- On Error GoTo Erreurs:
-
- Reponse = msgbox("Désirez-vous lancer la recherche des fonctions des modules" & vbCrLf & "- Sur les formulaires, états ET modules [Oui]" & _
- vbCrLf & "- Uniquement les formulaires et états [Non] ?", vbYesNo, "Type de recherche des fonctions")
- DoCmd.Hourglass True
- Drapeau_Fx = False: ReDim Fx(2, 1): c = 0
-
- 'On ouvre tous les modules
- For a = 0 To CurrentProject.AllModules.Count - 1
- DoCmd.OpenModule CurrentProject.AllModules(a).Name
- Next a
-
- For a = 0 To CurrentProject.AllModules.Count - 1
- Set Momo1 = Modules(CurrentProject.AllModules(a).Name)
-
- With Momo1
- Drapeau_Fx = False
- 'On détermine le nom des fonctions et procédures
- For Cur_Ligne = .CountOfDeclarationLines + 1 To .CountOfLines
- If Drapeau_Fx = False And UCase(.Lines(Cur_Ligne, 1)) Like "*SUB*(*)*" _
- Or UCase(.Lines(Cur_Ligne, 1)) Like "*FUNCTION*(*)*" Then
- 'On insère le nom de la procédure ou fonction et on redimensionne le tableau
- Fx(0, c) = .ProcOfLine(Cur_Ligne, vbext_pk_Proc): Fx(1, c) = "Module " & .Name & "=>" & .ProcOfLine(Cur_Ligne, vbext_pk_Proc): Fx(2, c) = False
- 'On passe à la suite
- Cur_Ligne = Cur_Ligne + .ProcCountLines(Fx(0, c), vbext_pk_Proc) - 1
- '-1 car .ProcCountLines positionne le curseur sur la dernière ligne de la fonction
- 'Mais, par le Next Cur_Ligne qui suit on loupe la ligne de la fonction suivante
- 'si on ne décrémente pas de 1
- c = c + 1
- ReDim Preserve Fx(2, c)
- Drapeau_Fx = True
- Else
- Drapeau_Fx = False
- End If
- Next Cur_Ligne
-
- If Reponse = vbNo Then GoTo 8
-
- 'On regarde dans tous les autres modules pour voir si cette fonction ou procédure est appelée
- For b = 0 To CurrentProject.AllModules.Count - 1 'Dans les autres modules
- Set Momo2 = Modules(CurrentProject.AllModules(b).Name)
-
- With Momo2
- DoCmd.OpenModule .Name
- If .Name <> Momo1.Name Then
- For d = 0 To UBound(Fx, 2) - 1
- Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
- d = d + 1
- If d = UBound(Fx, 2) Then
- d = d - 1
- Exit Do
- End If
- Loop
- If InStr(.Lines(.CountOfDeclarationLines, .CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
- Next d
- End If
- End With
- Next b
-
- 8 For b = 0 To CurrentProject.AllForms.Count - 1 'Dans les formulaires
- DoCmd.OpenForm CurrentProject.AllForms(b).Name, acDesign
- Set Forme = Forms(CurrentProject.AllForms(b).Name)
-
- With Forme
- For d = 0 To UBound(Fx, 2) - 1
- Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
- d = d + 1
- If d = UBound(Fx, 2) Then
- d = d - 1
- Exit Do
- End If
- Loop
-
- If InStr(.Module.Lines(.Module.CountOfDeclarationLines, .Module.CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
- Next d
- DoCmd.Close acForm, .Name, acSaveNo
- End With
-
- Next b
-
- For b = 0 To CurrentProject.AllReports.Count - 1 'Dans les états
- DoCmd.OpenReport CurrentProject.AllReports(b).Name, acViewDesign
- Set Etat = Reports(CurrentProject.AllReports(b).Name)
- With Etat
- For d = 0 To UBound(Fx, 2) - 1
- Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
- d = d + 1
- If d = UBound(Fx, 2) Then
- d = d - 1
- Exit Do
- End If
- Loop
- If InStr(.Module.Lines(.Module.CountOfDeclarationLines, .Module.CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
- Next d
- DoCmd.Close acReport, .Name, acSaveNo
- End With
- Next b
-
- End With
- 10 Next a
-
- 'Arrivé à ce stade, toutes les valeurs Fx(1,x) en False signifient que les procédures et fonctions F(0,x) ne sont sollicitée nulle part
- 'On les écrit dans la table
- For a = 0 To UBound(Fx, 2) - 1
- If Fx(2, a) = False Then DoCmd.RunSQL "INSERT INTO TR_ObjetNonTrouve (Type,Nom) VALUES('FUNCTION ou SUB','" & Fx(1, a) & "')"
- Next a
-
- 'On ferme tous les modules
- For a = 0 To CurrentProject.AllModules.Count - 1
- DoCmd.Close acModule, CurrentProject.AllModules(a).Name, acSaveNo
- Next a
-
- DoCmd.Hourglass False
- Exit Function
-
- Erreurs:
- If Err.Number = 7784 Then
- 'Erreur qui signifie qu'un sous formulaire a déja été ouvert par un formulaire
- Resume Next
- ElseIf Err.Number = 17 Then 'On ne peut pas fermer ce module car il n'a pas fini d'exécuter la fonction
- Resume Next
- Else
- msgbox Err.Description, vbCritical, "Erreur N° " & Err.Number
- Resume Next
- End If
- End Function
Public Function RechercheFonctionDansModule()
'Cette fonction permet de savoir si des fonctions sont utilisées ou non
Dim Momo1 As Module, Momo2 As Module, Nom_Fx As String, Cur_Ligne As Long, Ligne_en_cours As String, Lignes_Fx As Long, Drapeau_Fx As Boolean
Dim Forme As Form, Etat As Report, Reponse As Byte
Dim Fx() As String, a As Integer, b As Integer, c As Long, d As Long
'FX permet d'énumérer le nom des fonctions et procédures des modules.
'Sa structure est la suivante
'La première dimension indique le nom de la fonction ou procédure
'La seconde le nom du module et de la fonction
'La troisième si celle-ci a été trouvée dans un autre module
'Exemple Fx(0,0)="Florent":Fx(1,0)=False
On Error GoTo Erreurs:
Reponse = msgbox("Désirez-vous lancer la recherche des fonctions des modules" & vbCrLf & "- Sur les formulaires, états ET modules [Oui]" & _
vbCrLf & "- Uniquement les formulaires et états [Non] ?", vbYesNo, "Type de recherche des fonctions")
DoCmd.Hourglass True
Drapeau_Fx = False: ReDim Fx(2, 1): c = 0
'On ouvre tous les modules
For a = 0 To CurrentProject.AllModules.Count - 1
DoCmd.OpenModule CurrentProject.AllModules(a).Name
Next a
For a = 0 To CurrentProject.AllModules.Count - 1
Set Momo1 = Modules(CurrentProject.AllModules(a).Name)
With Momo1
Drapeau_Fx = False
'On détermine le nom des fonctions et procédures
For Cur_Ligne = .CountOfDeclarationLines + 1 To .CountOfLines
If Drapeau_Fx = False And UCase(.Lines(Cur_Ligne, 1)) Like "*SUB*(*)*" _
Or UCase(.Lines(Cur_Ligne, 1)) Like "*FUNCTION*(*)*" Then
'On insère le nom de la procédure ou fonction et on redimensionne le tableau
Fx(0, c) = .ProcOfLine(Cur_Ligne, vbext_pk_Proc): Fx(1, c) = "Module " & .Name & "=>" & .ProcOfLine(Cur_Ligne, vbext_pk_Proc): Fx(2, c) = False
'On passe à la suite
Cur_Ligne = Cur_Ligne + .ProcCountLines(Fx(0, c), vbext_pk_Proc) - 1
'-1 car .ProcCountLines positionne le curseur sur la dernière ligne de la fonction
'Mais, par le Next Cur_Ligne qui suit on loupe la ligne de la fonction suivante
'si on ne décrémente pas de 1
c = c + 1
ReDim Preserve Fx(2, c)
Drapeau_Fx = True
Else
Drapeau_Fx = False
End If
Next Cur_Ligne
If Reponse = vbNo Then GoTo 8
'On regarde dans tous les autres modules pour voir si cette fonction ou procédure est appelée
For b = 0 To CurrentProject.AllModules.Count - 1 'Dans les autres modules
Set Momo2 = Modules(CurrentProject.AllModules(b).Name)
With Momo2
DoCmd.OpenModule .Name
If .Name <> Momo1.Name Then
For d = 0 To UBound(Fx, 2) - 1
Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
d = d + 1
If d = UBound(Fx, 2) Then
d = d - 1
Exit Do
End If
Loop
If InStr(.Lines(.CountOfDeclarationLines, .CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
Next d
End If
End With
Next b
8 For b = 0 To CurrentProject.AllForms.Count - 1 'Dans les formulaires
DoCmd.OpenForm CurrentProject.AllForms(b).Name, acDesign
Set Forme = Forms(CurrentProject.AllForms(b).Name)
With Forme
For d = 0 To UBound(Fx, 2) - 1
Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
d = d + 1
If d = UBound(Fx, 2) Then
d = d - 1
Exit Do
End If
Loop
If InStr(.Module.Lines(.Module.CountOfDeclarationLines, .Module.CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
Next d
DoCmd.Close acForm, .Name, acSaveNo
End With
Next b
For b = 0 To CurrentProject.AllReports.Count - 1 'Dans les états
DoCmd.OpenReport CurrentProject.AllReports(b).Name, acViewDesign
Set Etat = Reports(CurrentProject.AllReports(b).Name)
With Etat
For d = 0 To UBound(Fx, 2) - 1
Do While Fx(2, d) = True 'Pour accélérer le parcours du tableau FX
d = d + 1
If d = UBound(Fx, 2) Then
d = d - 1
Exit Do
End If
Loop
If InStr(.Module.Lines(.Module.CountOfDeclarationLines, .Module.CountOfLines), Fx(0, d)) > 0 And Fx(2, d) = False Then Fx(2, d) = True
Next d
DoCmd.Close acReport, .Name, acSaveNo
End With
Next b
End With
10 Next a
'Arrivé à ce stade, toutes les valeurs Fx(1,x) en False signifient que les procédures et fonctions F(0,x) ne sont sollicitée nulle part
'On les écrit dans la table
For a = 0 To UBound(Fx, 2) - 1
If Fx(2, a) = False Then DoCmd.RunSQL "INSERT INTO TR_ObjetNonTrouve (Type,Nom) VALUES('FUNCTION ou SUB','" & Fx(1, a) & "')"
Next a
'On ferme tous les modules
For a = 0 To CurrentProject.AllModules.Count - 1
DoCmd.Close acModule, CurrentProject.AllModules(a).Name, acSaveNo
Next a
DoCmd.Hourglass False
Exit Function
Erreurs:
If Err.Number = 7784 Then
'Erreur qui signifie qu'un sous formulaire a déja été ouvert par un formulaire
Resume Next
ElseIf Err.Number = 17 Then 'On ne peut pas fermer ce module car il n'a pas fini d'exécuter la fonction
Resume Next
Else
msgbox Err.Description, vbCritical, "Erreur N° " & Err.Number
Resume Next
End If
End Function
Historique
- 04 mars 2008 20:13:58 :
- Nettoyage du mdb
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Récupérer nom de fonction dans un module sous Access [ par sleepman23 ]
Bonjour,voilà dans une liste d'un formulaire, j'aimerais récupérer le nom de fonction ou procédure que j'ai créée dans un module.Dans le module1, j'ai
[Access SQL]utilisation d'une fonction d'un module dans une requete SQL [ par Regnak ]
Bonjour a tous,Je voudrais faire marcher cette fonction de selection,Mais elle foire au niveau du WHERE :*DatePlusGrandQue : fonction d'un module d'ac
ACCESS VBA - Affecter le nom de la procédure en cours dans une variable [ par JM247L ]
Bonjour,Pour la mise en forme d'une gestion d'erreur dans une application Access, je souhaiterai pouvoir récupérer dans une variable le nom de la proc
créer une requète en fonction d'une sélection de filtres (ACCESS/VBA) [ par setfocus ]
Bonjour à tous,Je ne suis pas une grosse bete en développement, et aurai donc besoin de vos lumières en vba sur ACCESS...Dans un premier formulaire, l
La function Date() ne fonctione plus sous access 2003 [ par masqares ]
Ma question est simple,j'ai toujour utiliser la fonction d'Access pour requette ou formulaire Date() Maintenant() ?Mais pour je ne sait quel raison l
Module et form, appeler la fonction du module dans un form [ par xeeel ]
Salut,Dans un Module j'ai ceci ( permet d'ouvrir l'utilitaire de connexion des lecteurs reseaux): Module Module1
Urgent : Vb Access 2003 probleme avec clipboard [ par sam86 ]
Bonjour,Je suis debutant en visual basic, je l'utilise a l'occasion d'un stage en entreprise sur Microsoft access 2003 (Je cree un progamme permetant
Appeler une procedure dans un module access [ par skwalig ]
Bonjour, J'ai une base de données Access2003 dans laquelle il y a un module avec plusieurs procédures. Je souhaiterais appeler une de ces procédur
procédure / fonction [ par cpattin ]
quelqu'un pourrait m'expliquer les différences et les usages de chacune ?en me disant un peu plus que : "la fonction retourne une valeur" !merci
fonction afterupdate ne ce reactualise pas [ par simbabou ]
bonjourj'ai créé une petite procédure tte simple pour un afterupdate d'une zone de textePublic Sub Ref1_AfterUpdate() If IsNull(Ref1) = False Then
|
Derniers Blogs
[FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi WORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBEWORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBE par JeremyJeanson
Depuis déjà un an, je conseille vivement les utilisateurs de Workflow Foundation 3 à migrer vers la version 4. L'information qui va suivre ne devrait donc pas trop prendre au dépourvu les personnes qui m'ont suivi. Je profite de ce poste, pour faire le re...
Cliquez pour lire la suite de l'article par JeremyJeanson TECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PCTECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PC par ROMELARD Fabrice
Speakers: Thierry Rapatout, Antoine Petit et Xavier Trebbia Cette session entre dans le cadre des RDV Décideurs des TechDays 2012, elle est liée à la consumérisation de l'IT et la mise en place du "DeskTop as a Service" dans de plus en ...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLETECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLE par ROMELARD Fabrice
Speakers: Julien Marechal, Gautier Confiant, Sébastien MEYER La session débute par le positionnement de la solution System Center par rapport aux concepts d'organisation ITIL. Le portail du catalogue de se...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : PLEINIèRE SECOND JOURTECHDAYS PARIS 2012 : PLEINIèRE SECOND JOUR par ROMELARD Fabrice
Après une première journée dédiée aux développeurs, cette seconde journée est dédiée au monde des entreprises et de ses applications. Ainsi, cette pleinière est dédiée à faire un 360 de l'évolution des applications Business aux demandes ac...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
VB6 + GRAPHVIZVB6 + GRAPHVIZ par nouirayosra
Cliquez pour lire la suite par nouirayosra
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|