Classe VBA pour gérer les paramètres d'une application

oguruma

XLDnaute Occasionnel
Il est fréquent qu'en VBA que l'on ait besoin de paramètres se trouvant dans une ou plusieurs feuilles de calculs.
Si de nombreux paramètres sont nécessaires on peut très vite arriver à des situations compliquées et le code VBA pourrait en souffrir avec une série de Bugs.
Donc autant se l'éviter.

La solution 1 consisterait à rassembler tous les paramètres dans une feuille spécifique et pour chaque paramètre y accéder avec l'instruction RANGE. Cette solution est acceptable quand il y a très peu de paramètres. Une dizaine environ... ne pas aller au-delà.

Pour de gros développements avec un nombre de paramètres conséquents la solution 1 n'est pas franchement recommandée... sauf si on code à l'arrrachhhe "one shot"...

Solution 2 et c'est celle que je vais détailler en livrant deux classes.

On stocke en fait les paramètres dans une collection. On alimente la collection en lisant le tableau structuré contenant ces paramètres.
Donc il est nécessaire comme vous le verrez de mettre en place une procédure de chargement de ceux-ci dans la collection.
Pour y accéder on met à disposition une méthode GetParam("NOM_DU_PARAMETRE") --> 1ère colonne du tableau structuré..

Pour les moins chevronnés ils découvriront comment on met en oeuvre la POO en VBA.... ce n'est qu'un extrait. On peut aller plus loin mais ce n'est pas le but de ce post.

Aussi, documentez au maximum votre code. Combien j'ai lu de source... mal écrit et surtout.... quand on doit partir en spéléo dans les commentaires introuvables :) Grrrr


Méthodologie

- réunir vos paramètres dans un seul onglet (couleur rouge en général)
- les paramètres seront enregistrés dans un tableau structuré (inutile de rappeler les avantages des TS c'est largement documenté sur la toile)
- minimum 2 colonnes : identifiant (mot clef du paramètre), valeur. Eventuellement une colonne commentaires qui explique sa présence et pourquoi
- en général me concernant : Params = nom de l'onglet, nom du TS = TS_PARAMS

Et c'est là qu'intervient la classe permettant de gérer les paramètres. Le code source est ci-dessous largement documenté.
J'en expose aussi son utilisation via APPLICATION.CALLER qui permet de mettre en place une procédure d'appel universel.
Cela comme démonté à l'avantage de faire l'initialisation de la table une seule à l'appel de la procédure MAIN() qui pilote APPLICATION.CALLER

Je vous laisse lire le code.... il parle de lui-même.

Comment les utiliser

Option Explicit

Sub TEST_LOAD_PARAMS()

'************************************************************************************
'* La feuille Excel doit s'appeler Params
'* Le nom du tableau structuré TB_PARAMS
'* OTS_PARAMS : Objet de tableau global dans le module Mod_Global
'* Cette classe Static nous évite la déclaration de l'objet tableau
'************************************************************************************

Set OTS_PARAMS = New TB_PARAMS_STATIC
MsgBox "COLLECTION :: Nom de la table paramètres : " & OTS_PARAMS.GetTSParamName
MsgBox "COLLECTION :: Nbr de paramètres : " & OTS_PARAMS.GetNbParams
MsgBox "COLLECTION :: Valeur du paramètre TEST = " & OTS_PARAMS.GetParam("TEST")
MsgBox "COLLECTION :: Valeur du paramètre PARAM_INCONNU = " & OTS_PARAMS.GetParam("PARAM_INCONNU")

'************************************************************************************
'* Le nom de la feuille est libre
'* Le nom du tableau structuré est libre
'* La méthode oDynParam.Init doit être appelée à l'issue de l'instanciation
'* Exemple : oDynParam.Init("Params", "TB_PARAMS")
'* En passant par cette classe on peut gérer plusieurs tableaux de paramètres
'* Si l'objet exemple oDynParam est appelé dans plusieurs modules
'* il est recommandé de le déclaré public dans un module réservé
'************************************************************************************


'*=*=*=* *=*=*=*
'*=*=*=* Déclaration uniquement pour la procédure *=*=*=*
'*=*=*=* *=*=*=*
Dim oDynParam As TB_PARAMS_DYNAMIC
Set oDynParam = New TB_PARAMS_DYNAMIC
Call oDynParam.Init("Params", "TB_PARAMS")
MsgBox "COLLECTION :: oDynParam :: Valeur du paramètre TEST = " & oDynParam.GetParam("TEST")

'************************************************************************************
'* Exemple avec un objet Public GDynParam
'************************************************************************************
Set GDynParam = New TB_PARAMS_DYNAMIC
Call GDynParam.Init("Params", "TB_PARAMS")
MsgBox "COLLECTION :: GDynParam :: Valeur du paramètre TEST = " & GDynParam.GetParam("TEST")
End Sub


Comment les utiliser avec APPLICATION.CALLER via une procédure commune MAIN()

Option Explicit


Dim oDynParam As TB_PARAMS_DYNAMIC

Public Sub MAIN(Optional sDUMY As String)
Dim vAppel As Variant
Dim sType As String

'*******************************************************************************
'* Cas de la classe static - public - tous modules
'*******************************************************************************
Set OTS_PARAMS = New TB_PARAMS_STATIC

'*******************************************************************************
'* Cas de la classe dynamique - public - tous modules
'*******************************************************************************
Set GDynParam = New TB_PARAMS_DYNAMIC
Call GDynParam.Init("Params", "TB_PARAMS")

'*******************************************************************************
'* Cas de la classe dynamique - du module
'*******************************************************************************
Set oDynParam = New TB_PARAMS_DYNAMIC
Call oDynParam.Init("Params", "TB_PARAMS")

'*******************************************************************************
'* On remarque que les initialisations se font une seule fois
'* et qu'il possible d'appeler les paramètres quelque soit la procédure
'* en passant par l'astuce de MAIN avec APPLICATION.CALLER
'* on peut gérer l'appel de procédures ou fonctions communes
'*******************************************************************************

sType = TypeName(Application.Caller)
Select Case sType
Case "Range"
vAppel = Application.Caller.Address
Case "String"
vAppel = Application.Caller
Case "Error"
vAppel = "Error"
Case Else
vAppel = "unknown"
End Select
If sType <> "String" Then Exit Sub

Select Case vAppel
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' Bouton de la source
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Case "BTN_1"
BTN_1
Case "BTN_2"
BTN_2
Case "BTN_3"
BTN_3
Case Else
MsgBox "Pas de fonction disponible", vbExclamation
End Select

End Sub

Private Sub BTN_1()
MsgBox "OTS_PARAM Valeur du paramètre BTN1 = " & OTS_PARAMS.GetParam("BTN1")
MsgBox "GDynParam Valeur du paramètre BTN1 = " & GDynParam.GetParam("BTN1")
MsgBox "oDynParam Valeur du paramètre BTN1 = " & oDynParam.GetParam("BTN1")
End Sub

Private Sub BTN_2()
MsgBox "OTS_PARAM Valeur du paramètre BTN2 = " & OTS_PARAMS.GetParam("BTN2")
MsgBox "GDynParam Valeur du paramètre BTN2 = " & GDynParam.GetParam("BTN2")
MsgBox "oDynParam Valeur du paramètre BTN2 = " & oDynParam.GetParam("BTN2")
End Sub

Private Sub BTN_3()
MsgBox "OTS_PARAM Valeur du paramètre BTN3 = " & OTS_PARAMS.GetParam("BTN3")
MsgBox "GDynParam Valeur du paramètre BTN3 = " & GDynParam.GetParam("BTN3")
MsgBox "oDynParam Valeur du paramètre BTN3 = " & oDynParam.GetParam("BTN3")

End Sub

TB_PARAMS_STATIC


Option Explicit

'************************************************************************************
'* CLASSE DE PARAMETRES STATIC
'* La feuille Excel doit s'appeler Params
'* Le nom du tableau structuré TB_PARAMS
'* Le chargement des paramètres se fait à l'issue de l'initialisation de l'objet
'************************************************************************************



'************************************************************************************
'* A modifier si nécessaire selon le contexte de l'application
'************************************************************************************
Const WK_PARAMS As String = "Params"
Const TB_PARAMS As String = "TB_PARAMS"
'************************************************************************************

Private pTS_Params As ListObject
Private pWb_MACRO As Workbook
Private pNbParams As Integer
Private pName As String
Private pParameters As Collection

Private Sub Class_Initialize()

Set pWb_MACRO = ThisWorkbook
Set pParameters = New Collection
Set pTS_Params = pWb_MACRO.Worksheets(WK_PARAMS).ListObjects(TB_PARAMS)
pName = pTS_Params.Name

'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* On vérifie le nombre de lignes paramètres
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
If pTS_Params.DataBodyRange Is Nothing Then
pNbParams = 0
Else
pNbParams = pTS_Params.DataBodyRange.Rows.Count
End If

'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* Chargement des paramètre selon les valeurs statiques
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Call Load_Parameters


End Sub

Sub AddParam(hKey As String, hValue As Variant)
pParameters.Add Key:=hKey, Item:=hValue
End Sub

Function GetParam(hKey As String) As Variant
On Error Resume Next
GetParam = pParameters(hKey)
If Err Then GetParam = "<N/A>"
End Function

Function GetNbParams() As Integer
GetNbParams = pNbParams
End Function

Function GetTSParamName() As String
GetTSParamName = pTS_Params.Name
End Function

Private Sub Load_Parameters()
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* Chargement du tableau dans la collection
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Dim iParam As Integer
Dim sClef As String
Dim sValeur As String

On Error GoTo HANDLE_ERROR
For iParam = 1 To pNbParams
sClef = Trim(pTS_Params.DataBodyRange.Cells(iParam, 1))
sValeur = pTS_Params.DataBodyRange.Cells(iParam, 2)
If sClef <> "" Then
pParameters.Add Key:=sClef, Item:=sValeur
End If
Next

FIN:
Exit Sub

HANDLE_ERROR:
MsgBox "Erreur pendant le chargement des paramètres - Param N° : " & iParam & vbLf & _
"Err # " & Err.Number & vbLf & _
Err.Description, vbCritical, "PARAMETRES"
Resume FIN
End Sub


TB_PARAMS_DYNAMIC

Option Explicit

'************************************************************************************
'* CLASSE DE PARAMETRES DYNAMIC
'* La feuille Excel est libre
'* Le nom du tableau structuré est libre
'* Une procédure d'initialisation se charge de prendre en compte la feuille et le TS
'************************************************************************************



'************************************************************************************
'* A modifier si nécessaire selon le contexte de l'application
'* Ces paramètres spécifiques seront alimentés par une procédure d'initialisation
'************************************************************************************
Private pWK_PARAMS As String
Private pTB_PARAMS As String
'************************************************************************************

Private pTS_Params As ListObject
Private pWb_MACRO As Workbook
Private pNbParams As Integer
Private pName As String
Private pParameters As Collection

Private Sub Class_Initialize()
Set pParameters = New Collection
Set pWb_MACRO = ThisWorkbook
End Sub

Sub Init(hWK As String, hTB As String)

Set pTS_Params = pWb_MACRO.Worksheets(hWK).ListObjects(hTB)
pName = pTS_Params.Name

'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* On vérifie le nombre de lignes paramètres
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
If pTS_Params.DataBodyRange Is Nothing Then
pNbParams = 0
Else
pNbParams = pTS_Params.DataBodyRange.Rows.Count
End If

'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* Chargement des paramètre selon les valeurs statiques
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Call Load_Parameters
End Sub
Sub AddParam(hKey As String, hValue As Variant)
pParameters.Add Key:=hKey, Item:=hValue
End Sub

Function GetParam(hKey As String) As Variant
On Error Resume Next
GetParam = pParameters(hKey)
If Err Then GetParam = "<N/A>"
End Function

Function GetNbParams() As Integer
GetNbParams = pNbParams
End Function

Function GetTSParamName() As String
GetTSParamName = pTS_Params.Name
End Function

Private Sub Load_Parameters()
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'* Chargement du tableau dans la collection
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Dim iParam As Integer
Dim sClef As String
Dim sValeur As String

On Error GoTo HANDLE_ERROR
For iParam = 1 To pNbParams
sClef = Trim(pTS_Params.DataBodyRange.Cells(iParam, 1))
sValeur = pTS_Params.DataBodyRange.Cells(iParam, 2)
If sClef <> "" Then
pParameters.Add Key:=sClef, Item:=sValeur
End If
Next

FIN:
Exit Sub

HANDLE_ERROR:
MsgBox "Erreur pendant le chargement des paramètres - Param N° : " & iParam & vbLf & _
"Err # " & Err.Number & vbLf & _
Err.Description, vbCritical, "PARAMETRES"
Resume FIN
End Sub
 
Dernière édition:

oguruma

XLDnaute Occasionnel
Oup's...
ça n'était pas le bon fichier... plus une vieille version.... dsl
 

Pièces jointes

  • ClassTools_Parameters_1.0.xlsm
    41.3 KB · Affichages: 27

oguruma

XLDnaute Occasionnel
bsr, en effet une idée, ta proposition me laisse imaginer que tu as déjà été confronté à cette problématique.
L'avantage du TS c'est que ça reste à la portée de l'utilisateur si un changement de paramètre est nécessaire, ce qui peut être compliqué dans la solution que tu proposes ou alors j'ai fais une fausse interprétation de ta proposition. En termes d'échanges si tu as un exemple en "grosso merdo" je suis preneur ;)
Dans ta proposition si toujours ben compris les paramètres seraient protégés de toutes interventions extérieures si je suis dans le vrai ?
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 222
Membres
103 159
dernier inscrit
FBallea