joe.levrai

Bonjour,

Le sujet à l'origine de ce billet : http://www.developpez.net/forums/d16...sseurs-fermes/
Le tutoriel de prise en main du modèle objet de l'environnement VBE : http://silkyroad.developpez.com/VBA/VisualBasicEditor/


1) Introduction

N'hésitez pas à donner votre avis et formuler des remarques.
Il serait dommage de ne pas profiter des critiques pour s'améliorer !
Un sujet est ouvert à cet effet : http://www.developpez.net/forums/d16...res-categorie/
Sinon, un commentaire en bas du billet est également possible.

Ce billet ne cherche pas à fournir clé en main un utilitaire pour scanner et manager vos projets VBA.

Voyez ceci comme un début de boite à outils, mis en scène trivialement avec de la manipulation de macros par macro, et qui ne demande qu'à être personnalisé et agrémenté de nouveaux outils.
Je proposerai des axes d’évolutions possibles en fin de billet.

Les procédures/fonctions ont été écrites en liaisons tardives, contrairement au tutoriel de SilkyRoad qui travaille en liaison précoce
(ici pour le « kézako » : http://mhubiche.developpez.com/vba/f...endre/binding/).
Tout fonctionne à l'identique, à ceci près qu'il n'y a pas besoin d'activer la référence Microsoft Visual Basic for Applications Extensibility 5.3., ce qui facilite l'utilisation nomade d'un projet.

Chaque Objet déclaré en liaison tardive (Dim MonObjet As Object) sera commenté avec le nom explicite de l’objet, si vous souhaitez basculer le projet en liaison précoce.

2) Le contexte

Pour définir notre plan de bataille, mettons en situation tout bon bidouilleur vba bordélique développeur rigoureux :

Il a sur son ordinateur (ou un lecteur réseau) une profusion de projets, classeurs.
On peut retrouver des variables, fonctions, constantes, procédures identiques au sein de ces projets

Il souhaite s’équiper d’outils qui lui permettraient :

- De choisir, parmi une bibliothèque, "une action" sur un module, de façon intuitive
- De choisir fichier(s) et/ou dossiers(s) de fichiers pour constituer un lutin de fichiers à traiter
- D'effectuer cette action dans chaque projet avec possibilité de customiser le ciblage des modules à traiter : tous, un seul (connu), le premier positif


3) Les mains dans le cambouis

a_ Kit de création d'une bibliothèque de procédures intuitive : Couple Énumération/Fonction
b_ Kit d'appel, de traitement et de reporting d'une action
c_ Kit de création de la liste des fichiers



a_ Kit de création d'une bibliothèque de procédures intuitive : Couple Énumération/Fonction

L'idée de créer un catalogue de procédures d'action nécessite de prévoir une procédure capable de faire tourner tout ou partie du catalogue.
En ce sens, si l'on souhaite avoir plusieurs catégories d'actions dans la bibliothèque, on pourrait aisément imaginer avoir également un catalogue de procédures de traitement, pour chaque catégorie.

Pour ce billet, notre catégorie du catalogue sera limitée à un domaine et une seule procédure de traitement : faire "quelque chose" sur/dans un module
En partie 3.b, nous allons créer la procédure qui aura pour mission de faire tourner l'ensemble des éléments de notre bibliothèque.

Voici les règles de notre catégorie :
- Ce seront uniquement des fonctions, car tout élément de la bibliothèque va renvoyer un booléen
(Si une fonction nécessite le retour d'un autre type, on le passera par une variable de portée suffisante)

- Le premier paramètre de la fonction est le module où effectuer le traitement, le second paramètre est un Variant représentant l'ensemble des paramètres que doit utiliser la fonction.

Afin d'illustrer cette bibliothèque, on va créer deux briques basiques : Chercher et Remplacer dans un module

Principe de la fonction Chercher:
(1) Si le module contient au moins une ligne de code
(2) Utilisation de la fonction Instr() afin de vérifier l’existence (>0)

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function ValeurExisteDansModule(LeModule As Object, ByVal LaValeur As Variant) As Boolean 'LeModule As VBComponent
' LaValeur(1) = Valeur Cherchée (String)
    With LeModule.CodeModule
        If .CountOfLines > 0 Then ValeurExisteDansModule = InStr(1, .Lines(1, .CountOfLines), LaValeur(1)) > 0
            ' (1)                                                                             ' (2)
    End With
End Function

Principe de la fonction Remplacer :
(1) Si le module contient au moins une ligne de code
(2) Récupération du code dans une variable String
(3) Suppression du code du module
(4) Injection dans le module de la variable (2) dans laquelle on remplace l’ancienne valeur par la nouvelle

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Function RemplaceDansModule(LeModule As Object, ByVal MesArg As Variant) As Boolean 'LeModule As VBComponent
' MesArg(1) = Ancienne Valeur (String)
' MesArg(2) = Nouvelle Valeur (String)
Dim TexteModule As String
    With LeModule.CodeModule
        If .CountOfLines > 0 Then                                           ' (1)
            TexteModule = .Lines(1, .CountOfLines)                          '(2)
            .DeleteLines 1, .CountOfLines                                   ' (3)
            .AddFromString Join(Split(TexteModule, MesArg(1)), MesArg(2))   ' (4)
            If TexteModule <> .Lines(1, .CountOfLines) Then RemplaceDansModule = True
        End If
    End With
End Function

Puisque ce sont deux briques, on peut les assembler.
Par exemple : Chercher dans un module puis remplacer (pas très utile mais bon ...)

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub CouplerExistenceEtRemplacement()
Dim Ancien As String: Ancien = "MaValeur"
Dim Nouveau As String: Nouveau = "MaNouvelleValeur"
 
Dim LeModule As Object 'LeModule As VBComponent
Set LeModule = ThisWorkbook.VBProject.VBComponents("Module5")
 
If ValeurExisteDansModule(LeModule, Array(Ancien)) Then
    If RemplaceDansModule(LeModule, Array(Ancien, Nouveau)) Then
        MsgBox Ancien & " a été trouvé dans " & LeModule.Name & " puis remplacé par " & Nouveau & "."
    Else
        MsgBox Ancien & " a été trouvé dans " & LeModule.Name & " mais le remplacement par " & Nouveau & " a échoué."
    End If
Else
    MsgBox Ancien & " n'a pas été trouvé dans " & LeModule.Name
End If
 
End Sub

Il faut pouvoir présenter notre catalogue pour s'en servir intuitivement. Par exemple, par le menu de saisie intuitive, l'IntelliSense
L'Enumération est pratique pour ça ... sauf qu'elle n'apprécie pas les chaînes de caractères, il lui faut un Long
Il faut donc stocker indirectement le nom des procédures pour pouvoir ensuite les utiliser
On va donc construire notre sélecteur de brique au travers de trois éléments :

- Le nom de la procédure
- Le nom convivial de l'action
- Un numéro de procédure

Et utiliser une fonction pour faire correspondre les deux noms

L'énumération :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Public Enum Actions
    Rechercher = 1
    Remplacer = 2
End Enum

Kezako l'énumération : http://loufab.developpez.com/tutoriels/access/enumVBA/

La fonction de correspondance :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function ConvertEnum(MonEnum As Long) As String
    Select Case MonEnum
        Case 1
            ConvertEnum = "ValeurExisteDansModule"
        Case 2
            ConvertEnum = "RemplaceDansModule"
    End Select
End Function

On obtient facilement le nom de la procédure :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub AfficherNomProc()
    ' affichera le nom de la fonction "ValeurExisteDansModule"
    MsgBox ConvertEnum(Actions.Rechercher)
 
    ' affichera le nom de la procédure "RemplaceDansModule"
    MsgBox ConvertEnum(Actions.Remplacer)
End Sub

Avec une facilité de rédaction :


Nos briques sont maintenant rangées et ne demandent qu'à en accueillir des nouvelles.

b) Kit d'appel, de traitement et de reporting d'une action

Nous allons maintenant mettre en place le liant de notre machinerie : une procédure capable de lire toutes les briques de notre catégorie.
Encore une fois.... ce sera une fonction !
Mais elle renverra un Variant, histoire d'être assez souple sur les informations post-traitement qu'on souhaite remonter

Si nous reprenons les attendus analysés en partie 2, notre fonction doit :

- Recevoir une action, tirée de notre bibliothèque, à effectuer
- Traiter l'action sur un ensemble de projets
- Etre capable de parcourir tout ou partie du projets, le choix étant laissé à la procédure appelante.

D'où la décision d'utiliser les paramètres suivants :

- Un Variant contenant la liste des classeurs à ouvrir
- Un String pour l'action de notre bibliothèque à effectuer
- Un Variant optionnel contenant les arguments de l'action
- Un String optionnel contenant le nom d'un module (si on souhaite en chercher un en particulier)
- Un Booléen optionnel pour s'arrêter après le premier module positivement traité

Principe de la fonction Traitement :
(1) On crée un tableau local des résultats
(2) On parcourt la liste des fichiers pour les ouvrir (2Bis)
(3) Si module connue, on le traite uniquement, sinon on traite tous les modules (3Bis)
(4) Via Application.Run, on va lancer la procédure et lui fournir les arguments (vous comprenez maintenant pourquoi nos fonctions catalogues stockent tous les paramètres dans un unique Variant ).
(5) Alimentation du tableau de résultat si le test est positif
(6) On n'oublie pas de s'arrêter au premier module positivement testé si besoin
(7) On retourne le résultat à la procédure appelante, s'il y en a au moins 1

J'ai arbitrairement intégré, en terme de reporting, le listing des modules & fichiers où un traitement positif a été effectué.

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function Traitement(LesFichiers As Variant, UneAction As String, Optional Arguments As Variant, _
           Optional ModuleUnique As String = "", Optional PremiereOccurence As Boolean = False) As Variant
 
Dim Resultat(), LeModule As Object  'LeModule As VBComponent
ReDim Resultat(1): Resultat(1) = "Module : Fichier"                                                 '(1)
 
Application.ScreenUpdating = False
    For j = LBound(LesFichiers) To UBound(LesFichiers)                                              '(2)
        With Workbooks.Open(LesFichiers(j))                                                         '(2Bis)
            If ModuleUnique <> "" Then                                                              '(3)
                If Application.Run(UneAction, .VBProject.VBComponents(ModuleUnique), Arguments) Then'(4)
 
                    ReDim Preserve Resultat(UBound(Resultat) + 1)
                    Resultat(UBound(Resultat)) = ModuleUnique & " : " & .Name                       '(5)
                End If
            Else                                                                                    '(3Bis)
                For Each LeModule In .VBProject.VBComponents
                    If Application.Run(UneAction, LeModule, Arguments) Then                         '(4)
                        ReDim Preserve Resultat(UBound(Resultat) + 1)
                        Resultat(UBound(Resultat)) = LeModule.Name & " : " & .Name                  '(5)
                        If PremiereOccurence Then Exit For                                          '(6)
                    End If
                Next LeModule
            End If
 
            .Close True
        End With
    Next j
 
    If UBound(Resultat) > 1 Then Traitement = Resultat                                              '(7)
Application.ScreenUpdating = True
End Function

Voici un exemple d'appel, sur un classeur écrit en dur, avec un mot à chercher écrit en dur (oui oui, tout ça on doit encore le construire !)

La recherche s'effectue dans l'ensemble du projet, sans cibler un module particulier, ni s'arrêter au premier module trouvé

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub MacroRecherche()
Dim TableauRetour(), i As Long
    TableauRetour = Traitement(Array("C:\Users\toto.xlsm"), ConvertEnum(Actions.Rechercher), Array("UneExpression"))
' Pour afficher les modules
For i = LBound(TableauRetour) To UBound(TableauRetour)
    Debug.Print TableauRetour(i)
Next i
 
End Sub

Exemple avec la procédure de remplacement :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub MacroRemplace()
Dim TableauRetour(), i As Long
    TableauRetour = Traitement(Array("C:\Users\toto.xlsm"), ConvertEnum(Actions.Remplacer), Array("Ancien", "Nouveau"))
 
For i = LBound(TableauRetour) To UBound(TableauRetour)
    Debug.Print TableauRetour(i)
Next i
 
End Sub

Il ne nous reste qu'à industrialiser les récupération d'arguments et tâches qu'on a écrit en dur dans nos deux exemples.
Là encore, nous utiliserons des procédures réalisant ces tâches :

- La constitution de la liste des fichiers

ce sera notre 3.c

- Obtenir de l'utilisateur la liste des paramètres String

Dans une fonction, nous allons, par InputBox, les demander, en personnalisant le titre de la boite de dialogue :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Function ObtientUneExpression(LeTitre As String) As String
    ObtientUneExpression = InputBox("", LeTitre)
End Function

- Traiter les résultats obtenus

Dans une procédure, nous allons réaliser un export de notre tableau de reporting, dans la feuille souhaitée, avec nettoyage (ou non) préalable de la feuille :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub ExporteResultat(LaFeuille As Worksheet, LeResultat As Variant, Optional EffaceTout As Boolean = False)
    With LaFeuille
        If EffaceTout Then .Cells.ClearContents
        .Range("A1").Resize(UBound(LeResultat)).Value = LeResultat
        .Columns(1).AutoFit
    End With
End Sub

Bien entendu, certaines modalités ont été arbitrairement définies, comme la plage d'export, et peuvent également faire l'objet d'une customisation

Ce qui rend déjà plus universel nos deux précédents exemples

Chercher :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub MacroRecherche()
Dim Expression As String, TableauRetour()
    Expression = ObtientUneExpression("Quelle valeur chercher ?")
 If Expression = "" Then Exit Sub
 
TableauRetour = Traitement(Array("C:\Users\toto.xlsm"), ConvertEnum(Actions.Rechercher), Array(Expression))
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(TableauRetour)
End Sub

Remplacer :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub MacroRemplace()
Dim Ancien As String, Nouveau As String, TableauRetour()
    Ancien = ObtientUneExpression("Quelle valeur chercher ?")
 If Ancien = "" Then Exit Sub Else Nouveau = ObtientUneExpression("Remplacer " & Ancien & " par ?")
                                If Nouveau = "" Then Exit Sub
 
TableauRetour = Traitement(Array("C:\Users\toto.xlsm"), ConvertEnum(Actions.Remplacer), Array(Ancien, Nouveau))
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(TableauRetour)
 
End Sub

Ne reste qu'à créer notre lutin de classeurs


c) Kit de création de la liste des fichiers

Les attendus de notre kit sont les suivants :

- Collecter une liste de chemin d'accès à des classeurs excel type xlsm et la fournir à la procédure appelante
- Pouvoir intégrer des fichiers sélectionnés, ou tous les fichiers figurant dans un dossier sélectionné
- Laisser l'utilisateur continuer ou stopper la collecte après chaque sélection

Il faut donc pouvoir jongler entre les deux Selecteurs "Fichiers" et Dossiers.
Ces deux sélecteurs partagent de nombreuses propriétés communes, et on peut les appeler au moyen d'une constante VBA

On va d'entrée de jeu simplifier la collecte des fichiers d'un dossier, par une fonction dédiée :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function RecupFichiersDuDossiers(CheminDossier As String) As Variant
Dim LeFichier As String, ListeFichiers As String
Const SEP As String = "?"
 
LeFichier = Dir(CheminDossier & "\" & "*.xlsm")
    Do While Len(LeFichier) > 0
        ListeFichiers = ListeFichiers & SEP & CheminDossier & "\" & LeFichier
        LeFichier = Dir()
    Loop
RecupFichiersDuDossiers = Split(Mid(ListeFichiers, 2), SEP)
End Function

Elle nous renvoie un Array unidimensionnel avec l'ensemble des chemins des fichiers xlsm du dossier

EDIT : après une judicieuse remarque de davido84 ICI, la constante SEP, qui était ";", a été remplacée par "?" pour plus de sécurité.

Nous allons maintenant construire notre fonction principale, en utilisant les variables suivantes :

- Un Long qui va stocker le numéro du type de sélecteur
- Un Booléen pour contrôler l'arrêt du processus du collecte
- Diverses variables pour travailler dans la procédure


Principe de la fonction ChoisirLesFichiers :
(1) Demander à l'utilisateur le Type de sélecteur pour démarrer
(2) Afficher la boite de sélection et filtrer les fichiers si c'est une collecte de fichiers (2Bis)
(3) Sur l'ensemble de la sélection effectuée
(4) Si ce sont des fichiers : on les intègre à notre lutin
(5) Si ce sont des dossiers : on demande à notre sous-fonction la liste des fichiers
(6) Pour les intégrer à notre lutin
(7) Proposer à l’utilisateur de choisir la suite des évènements
(8) Changer de type de sélecteur
(9) Arrêter la collecte
(10) Poursuivre la collecte avec le même type de sélecteur
(11) Transmettre les fichiers, s'il y en a, à la procédure appelante

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function ChoisirLesFichiers() As Variant
Dim j As Long, i As Long, Tabl(), Stopper As Boolean, TypeSelecteur As Long, ListingFichiers
 
' 3 pour fichiers, correspondant à la constante 'msoFileDialogFilePicker'
' 4 pour dossiers, correspondant à la constante 'msoFileDialogFolderPicker'
' (1) 
TypeSelecteur = IIf(MsgBox("Commencer avec les fichiers ?" & vbCrLf & vbCrLf & _
                    "OUI : Sélection de fichiers" & vbCrLf & "NON : Sélection de dossiers", vbYesNo) = vbYes, 3, 4)
 
ReDim Tabl(1): Tabl(1) = "Fichiers à parcourir"
 
 
While Not Stopper
    With Application.FileDialog(TypeSelecteur)                                      ' (2) 
        .Filters.Clear
        If TypeSelecteur = 3 Then .Filters.Add "Classeur xlsm", "*.xlsm"            ' (2Bis) 
        .AllowMultiSelect = True
 
        If .Show = True Then
            For j = 1 To .SelectedItems.Count                                       '  (3) 
                If TypeSelecteur = 3 Then                                           ' (4) 
                    ReDim Preserve Tabl(UBound(Tabl) + 1)
                    Tabl(UBound(Tabl)) = .SelectedItems(j)
                Else
                    ListingFichiers = RecupFichiersDuDossiers(.SelectedItems(j))    ' (5) 
                    For i = LBound(ListingFichiers) To UBound(ListingFichiers)      ' (6) 
                        ReDim Preserve Tabl(UBound(Tabl) + 1)
                        Tabl(UBound(Tabl)) = ListingFichiers(i)
                    Next i
                End If
            Next j
        End If
    End With
 
    ' (7) 
    Select Case MsgBox("Que voulez-vous faire : " & vbCrLf & vbCrLf & _
                       "OUI : Continuer avec les " & IIf(TypeSelecteur = 3, "fichiers", "dossiers") & vbCrLf & _
                       "NON : Continuer avec des " & IIf(TypeSelecteur = 3, "dossiers", "fichiers") & vbCrLf & _
                       "ANNULER : stopper la collecte", vbYesNoCancel)
        Case vbNo
            TypeSelecteur = IIf(TypeSelecteur = 3, 4, 3)                            ' (8) 
        Case vbCancel
            Stopper = True                                                          ' (9) 
    End Select
Wend                                                                                ' (10) 
 
If UBound(Tabl) = 1 Then ChoisirLesFichiers = Tabl                                  '  (11) 
End Function

Nous voici enfin prêts à tirer profit de toute cette machinerie !


4) Récolter les fruits


Voici deux exemples détaillés

Rechercher :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub MacroRechercheDetaillee()
Dim Expression As String, TableauRetour(), MesFichiers, MonAction As String, OuExporter As Worksheet
    Expression = ObtientUneExpression("Quelle valeur chercher ?")
 If Expression = "" Then Exit Sub
 
Set OuExporter = ThisWorkbook.Worksheets.Add
MesArguments = Array(Expression)
MonAction = ConvertEnum(Actions.Rechercher)
MesFichiers = ChoisirLesFichiers
 
TableauRetour = Application.Transpose(Traitement(MesFichiers, MonAction, MesArguments))
 
ExporteResultat OuExporter, TableauRetour
End Sub

Remplacer :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub MacroRemplaceDetaillee()
Dim Ancien As String, Nouveau As String, TableauRetour(), MesFichiers, MonAction As String, OuExporter As Worksheet
    Ancien = ObtientUneExpression("Quelle valeur chercher ?")
 If Ancien = "" Then Exit Sub Else Nouveau = ObtientUneExpression("Remplacer " & Ancien & " par ?")
                                If Nouveau = "" Then Exit Sub
 
 
Set OuExporter = ThisWorkbook.Worksheets.Add
MesArguments = Array(Ancien, Nouveau)
MonAction = ConvertEnum(Actions.Remplacer)
MesFichiers = ChoisirLesFichiers
 
TableauRetour = Application.Transpose(Traitement(MesFichiers, MonAction, MesArguments))
 
ExporteResultat OuExporter, TableauRetour
End Sub

On remarque ainsi les relatives similitudes pour appeler notre procédure de traitement

En réduisant nos variables intermédiaires ...

Rechercher :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub MacroRecherche()
Dim Expression As String
    Expression = ObtientUneExpression("Quelle valeur chercher ?")
 If Expression = "" Then Exit Sub
 
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(Traitement(ChoisirLesFichiers, ConvertEnum(Actions.Rechercher), Array(Expression)))
End Sub

Remplacer :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub MacroRemplace()
Dim Ancien As String, Nouveau As String
    Ancien = ObtientUneExpression("Quelle valeur chercher ?")
 If Ancien = "" Then Exit Sub Else Nouveau = ObtientUneExpression("Remplacer " & Ancien & " par ?")
                                If Nouveau = "" Then Exit Sub
 
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(Traitement(ChoisirLesFichiers, ConvertEnum(Actions.Remplacer), Array(Ancien, Nouveau)))
 
End Sub

5) Sécurité, raccourcis et perspectives

Ce billet fut long, très long.
J'ai décidé d'arbitrer la création de ce kit en éludant certains points de sécurité qu'il sera conseillé d'enrichir pour une meilleur stabilité

L'ensemble du projet est monté en Base 1, il ne faudra donc pas oublier de l'ajouter en haut de chaque module utilisé par ce projet.
Ce dernier peut d'ailleurs tenir dans un seul module, ou être dispatché par catégorie de kit. Aucune variable publique ou de portée module n'a été nécessaire de cet exemple

J'ai disséminé au sein du billet plusieurs pistes d'évolutions possibles, le champ est très large. Ce kit est illustratif et visait avant tout à mettre en lumière une méthode de gestion par bibliothèque catégorisée de procédures.

On pourrait par exemple déporter la gestion des reportings dans un kit dédié, car actuellement il est très primaire.
Ou encore, développer d'autres catégories de procédures qui serait utilisées dans un autre contexte que de la manipulation de VBE (ranger des fonctions de calcul personnelles, manager des feuilles de calcul, des contrôles, des formulaires etc...). Cela est assez simple, qu'on décide de créer une nouvelle énumération dédiée ou non (la fonction de Conversion pourra en gérer plusieurs sans aucun aménagement !)
Là, on tombe dans le domaine du "un outil pour quel besoin ?" et de la créativité !

Attention également, les méthodes de recherche/remplacement de chaines sont sensibles à la casse, et fonctionnent en xlPart (recherche partielle) plutôt qu'en xlWhole (recherche "mot complet")

Ceci clos notre première partie, la gestion "modulaire" de ce kit
Dans de prochains billets, nous consolideront peut-être les choses :

- renforcer la sécurité
- enrichir notre catégorie existante
- développer des nouvelles catégories dans notre bibliothèque
- basculer en gestion "formulaire", qui pilotera l'organisation et l'emploi de notre bibliothèque.
- et que sais-je encore ? Vous avez des idées et des souhaits ?



6) Le kit complet


- La bibliothèque et sa gestion

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Base 1
 
Public Enum Actions
    Rechercher = 1
    Remplacer = 2
End Enum
 
Function ConvertEnum(MonEnum As Long) As String
    Select Case MonEnum
        Case 1
            ConvertEnum = "ValeurExisteDansModule"
        Case 2
            ConvertEnum = "RemplaceDansModule"
    End Select
End Function
 
 
Function ValeurExisteDansModule(LeModule As Object, ByVal LaValeur As Variant) As Boolean 'LeModule As VBComponent
' LaValeur(1) = Valeur Cherchée (String)
    With LeModule.CodeModule
        If .CountOfLines > 0 Then ValeurExisteDansModule = InStr(1, .Lines(1, .CountOfLines), LaValeur(1)) > 0
    End With
End Function
 
Function RemplaceDansModule(LeModule As Object, ByVal MesArg As Variant) As Boolean 'LeModule As VBComponent
' MesArg(1) = Ancienne Valeur (String)
' MesArg(2) = Nouvelle Valeur (String)
Dim TexteModule As String
    With LeModule.CodeModule
        If .CountOfLines > 0 Then
            TexteModule = .Lines(1, .CountOfLines)
            .DeleteLines 1, .CountOfLines
            .AddFromString Join(Split(TexteModule, MesArg(1)), MesArg(2))
            If TexteModule <> .Lines(1, .CountOfLines) Then RemplaceDansModule = True
        End If
    End With
End Function

- La collecte des fichiers :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Base 1
 
Function ChoisirLesFichiers() As Variant
Dim j As Long, i As Long, Tabl(), Stopper As Boolean, TypeSelecteur As Long, ListingFichiers
 
' 3 pour fichiers, correspondant à la constante 'msoFileDialogFilePicker'
' 4 pour dossiers, correspondant à la constante 'msoFileDialogFolderPicker'
TypeSelecteur = IIf(MsgBox("Commencer avec les fichiers ?" & vbCrLf & vbCrLf & _
                    "OUI : Sélection de fichiers" & vbCrLf & "NON : Sélection de dossiers", vbYesNo) = vbYes, 3, 4)
 
ReDim Tabl(1): Tabl(1) = "Fichiers à parcourir"
 
 
While Not Stopper
    With Application.FileDialog(TypeSelecteur)
        .Filters.Clear
        If TypeSelecteur = 3 Then .Filters.Add "Classeur xlsm", "*.xlsm"
        .AllowMultiSelect = True
 
        If .Show = True Then
            For j = 1 To .SelectedItems.Count
                If TypeSelecteur = 3 Then
                    ReDim Preserve Tabl(UBound(Tabl) + 1)
                    Tabl(UBound(Tabl)) = .SelectedItems(j)
                Else
                    ListingFichiers = RecupFichiersDuDossiers(.SelectedItems(j))
                    For i = LBound(ListingFichiers) To UBound(ListingFichiers)
                        ReDim Preserve Tabl(UBound(Tabl) + 1)
                        Tabl(UBound(Tabl)) = ListingFichiers(i)
                    Next i
                End If
            Next j
        End If
    End With
 
    Select Case MsgBox("Que voulez-vous faire : " & vbCrLf & vbCrLf & _
                       "OUI : Continuer avec les " & IIf(TypeSelecteur = 3, "fichiers", "dossiers") & vbCrLf & _
                       "NON : Continuer avec des " & IIf(TypeSelecteur = 3, "dossiers", "fichiers") & vbCrLf & _
                       "ANNULER : stopper la collecte", vbYesNoCancel)
        Case vbNo
            TypeSelecteur = IIf(TypeSelecteur = 3, 4, 3)
        Case vbCancel
            Stopper = True
    End Select
Wend
 
If UBound(Tabl) = 1 Then ChoisirLesFichiers = Tabl
End Function
 
Function RecupFichiersDuDossiers(CheminDossier As String) As Variant
Dim LeFichier As String, ListeFichiers As String
Const SEP As String = "?"
 
LeFichier = Dir(CheminDossier & "\" & "*.xlsm")
    Do While Len(LeFichier) > 0
        ListeFichiers = ListeFichiers & SEP & CheminDossier & "\" & LeFichier
        LeFichier = Dir()
    Loop
RecupFichiersDuDossiers = Split(Mid(ListeFichiers, 2), SEP)
End Function

- Les procédures/fonctions annexes :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Base 1
 
Function ObtientUneExpression(LeTitre As String) As String
    ObtientUneExpression = InputBox("", LeTitre)
End Function
 
Sub ExporteResultat(LaFeuille As Worksheet, LeResultat As Variant, Optional EffaceTout As Boolean = False)
    With LaFeuille
        If EffaceTout Then .Cells.ClearContents
        .Range("A1").Resize(UBound(LeResultat)).Value = LeResultat
        .Columns(1).AutoFit
    End With
End Sub

- La procédure de traitement :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Base 1
 
Function Traitement(LesFichiers As Variant, UneAction As String, Optional Arguments As Variant, _
           Optional ModuleUnique As String = "", Optional PremiereOccurence As Boolean = False) As Variant
 
Dim Resultat(), LeModule As Object  'LeModule As VBComponent
ReDim Resultat(1): Resultat(1) = "Module : Fichier"
 
Application.ScreenUpdating = False
    For j = LBound(LesFichiers) To UBound(LesFichiers)
        With Workbooks.Open(LesFichiers(j))
            If ModuleUnique <> "" Then
                If Application.Run(UneAction, .VBProject.VBComponents(ModuleUnique), Arguments) Then
                    ReDim Preserve Resultat(UBound(Resultat) + 1)
                    Resultat(UBound(Resultat)) = ModuleUnique & " : " & .Name
                End If
            Else
                For Each LeModule In .VBProject.VBComponents
                    If Application.Run(UneAction, LeModule, Arguments) Then
                        ReDim Preserve Resultat(UBound(Resultat) + 1)
                        Resultat(UBound(Resultat)) = LeModule.Name & " : " & .Name
                        If PremiereOccurence Then Exit For
                    End If
                Next LeModule
            End If
 
            .Close True
        End With
    Next j
 
    If UBound(Resultat) > 1 Then Traitement = Resultat
Application.ScreenUpdating = True
End Function

- Nos deux exemples d'appel, détaillés et raccourcis :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Base 1
 
Sub MacroRemplace()
Dim Ancien As String, Nouveau As String
    Ancien = ObtientUneExpression("Quelle valeur chercher ?")
 If Ancien = "" Then Exit Sub Else Nouveau = ObtientUneExpression("Remplacer " & Ancien & " par ?")
                                If Nouveau = "" Then Exit Sub
 
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(Traitement(ChoisirLesFichiers, ConvertEnum(Actions.Remplacer), Array(Ancien, Nouveau)))
End Sub
 
Sub MacroRemplaceDetaillee()
Dim Ancien As String, Nouveau As String, TableauRetour(), MesFichiers, MonAction As String, OuExporter As Worksheet
    Ancien = ObtientUneExpression("Quelle valeur chercher ?")
 If Ancien = "" Then Exit Sub Else Nouveau = ObtientUneExpression("Remplacer " & Ancien & " par ?")
                                If Nouveau = "" Then Exit Sub
 
 
Set OuExporter = ThisWorkbook.Worksheets.Add
MesArguments = Array(Ancien, Nouveau)
MonAction = ConvertEnum(Actions.Remplacer)
MesFichiers = ChoisirLesFichiers
 
TableauRetour = Application.Transpose(Traitement(MesFichiers, MonAction, MesArguments))
 
ExporteResultat OuExporter, TableauRetour
End Sub
 
 
Sub MacroRecherche()
Dim Expression As String
    Expression = ObtientUneExpression("Quelle valeur chercher ?")
 If Expression = "" Then Exit Sub
 
ExporteResultat ThisWorkbook.Worksheets.Add, Application.Transpose(Traitement(ChoisirLesFichiers, ConvertEnum(Actions.Rechercher), Array(Expression)))
End Sub
 
Sub MacroRechercheDetaillee()
Dim Expression As String, TableauRetour(), MesFichiers, MonAction As String, OuExporter As Worksheet
    Expression = ObtientUneExpression("Quelle valeur chercher ?")
 If Expression = "" Then Exit Sub
 
Set OuExporter = ThisWorkbook.Worksheets.Add
MesArguments = Array(Expression)
MonAction = ConvertEnum(Actions.Rechercher)
MesFichiers = ChoisirLesFichiers
 
TableauRetour = Application.Transpose(Traitement(MesFichiers, MonAction, MesArguments))
 
ExporteResultat OuExporter, TableauRetour
End Sub