Microsoft 365 Générer des quiitances de Loyer

Option Explicit
' -----------------ARGUMENT RUBBERDUCK-----------------------------
'@ModuleDescription "Initialisation des tableaux structurés."
'@IgnoreModule
'@Folder "System"

' -----------------DESCRIPTION-------------------------------------
' Module : [Factory]
' Description : Initialisation des tabeaux stucturés.
' Auteur : Jean-Paul Grumel (Valtrase)
' Date de Création : 14/04/2023
' Dernière Modification : 27/01/2026
' Version : 1.2

' -----------------------------------------------------------------
' Clause de Redistribution et d'Utilisation
' Redistribution and Usage Clause
' -----------------------------------------------------------------
'
' Ce code est fourni **à titre d'exemple** et est destiné à des fins
' éducatives ou d'illustration uniquement.
' This code is provided **as an example** and is intended for
' educational or illustrative purposes only.
'
' **Redistribution :**
' Vous avez la permission de redistribuer, modifier et utiliser ce code
' dans vos projets.
' You have permission to redistribute, modify, and use this code
' in your projects.
'
' **Attribution :**
' Toute redistribution ou utilisation substantielle de ce code doit
' impérativement **citer l'auteur original Jean-Paul Grumel (Valtrase)**.
' Any substantial redistribution or use of this code must
' absolutely **cite the original author Jean-Paul Grumel (Valtrase)**.
'
' **Clause de Non-Responsabilité :**
' **Disclaimer :**
'
' Ce code est fourni "tel quel", sans garantie d'aucune sorte, expresse
' ou implicite, y compris, mais sans s'y limiter, les garanties de
' qualité marchande, d'adéquation à un usage particulier et de non-
' contrefaçon. L'auteur ne sera en aucun cas responsable de tout
' dommage direct, indirect, spécial, accessoire ou consécutif découlant
' de l'utilisation ou de l'incapacité d'utiliser le code.
' This code is provided "as is", without warranty of any kind, express
' or implied, including but not limited to the warranties of
' merchantability, fitness for a particular purpose and non-
' infringement. In no event shall the author be liable for any
' direct, indirect, special, incidental, or consequential damages
' arising from the use or inability to use the code.
'
' -----------------------------------------------------------------

'@Description "Retourne un objet ListObject s'il existe sinon retourne Nothing"
Private Function getListObject( _
        ByVal ListName As String, _
        Optional ByVal Workbook As Excel.Workbook _
        ) As Excel.ListObject

    Dim localWorkbook As Excel.Workbook
    Set localWorkbook = Workbook
    If localWorkbook Is Nothing Then Set localWorkbook = ThisWorkbook
    
    With localWorkbook
        Do
            Dim CounterSheets As Integer
            CounterSheets = CounterSheets + 1
            Dim CounterListObjects As Integer: CounterListObjects = 0
            With .Worksheets(CounterSheets)
                Do While CounterListObjects < .ListObjects.Count And getListObject Is Nothing
                    CounterListObjects = CounterListObjects + 1
                    If StrComp(ListName, .ListObjects(CounterListObjects).Name, vbTextCompare) = 0 Then Set getListObject = .ListObjects(CounterListObjects)
                Loop
            End With
        Loop While CounterSheets < .Worksheets.Count And getListObject Is Nothing
    End With
End Function

''@Description "Initialise le tableau des paramètres."
'Public Function InitTabSettings( _
'       Optional ByVal Reset As Boolean _
'       ) As ListObject
'
'    Static item As ListObject
'    If item Is Nothing Or Reset Then
'        Set item = getListObject("vt_Settings")
'    End If
'    Set InitTabSettings = item
'End Function

'@Description "Initialise le tableau des données de base."
Public Function InitTabData( _
       Optional ByVal Reset As Boolean _
       ) As ListObject
    
    Static item As ListObject
    If item Is Nothing Or Reset Then
        Set item = getListObject("vt_Clients")
    End If
    Set InitTabData = item
End Function

'@Folder("Workbook")
Option Explicit

' -----------------CONSTANTES POUR LA GESTION DES PARAMETRES-------
Public Const SETTINGS_COL_KEYS_NAME As String = "Keys"
Public Const SETTINGS_COL_VALUES_NAME As String = "Values"
Public Const SETTINGS_COL_INITIALVALUES_NAME As String = "Initial values"
Public Const SETTINGS_COL_NOTES_NAME As String = "Notes"

' -----------------CONSTANTES POUR LA GESTION DU TABLEAU CLIENTS-------
Public Const CLIENTS_ID As String = "ID"
Public Const CLIENTS_FIRST_NAME As String = "Prénom"
Public Const CLIENTS_LAST_NAME As String = "Nom"
Public Const CLIENTS_ADDRESS As String = "Adresse"
Public Const CLIENTS_CITY As String = "Ville"
Public Const CLIENTS_POSTAL_CODE As String = "CP"
Public Const CLIENTS_MAIL As String = "Courriel"
Public Const CLIENTS_USERNAME As String = "User Name"
Public Const CLIENTS_TELEPHONE_CODE As String = "Indicatif"
Public Const CLIENTS_TELEPHONE As String = "Téléphone"
Public Const CLIENTS_BIRTHDAY As String = "Anniverssaire"

    ' //  Affectation du tableau à une variable table ici déclarée en 'Private'.
    Set table = Factory.InitTabData
    If table Is Nothing Then
        Err.Raise Number:=vbObjectError + 10010, Source:=Me.Name & ".Activate", Description:="Impossible d'initialiser la table."
    End If

Option Explicit


Private table As Excel.ListObject

Private Sub UserForm_Activate()
    On Error GoTo Catch
    
    ' //  Affectation du tableau à une variable table ici déclarée en 'Private'.
    Set table = Factory.InitTabData
    If table Is Nothing Then
        ' // On pourait regrouper les erreurs dans un module ou classe approprié(e).
        Err.Raise Number:=vbObjectError + 10010, Source:=Me.Name & ".Activate", Description:="Impossible d'initialiser la table."
    End If
    
    Dim newRow As Excel.ListRow
    Set newRow = table.ListRows.Add
    If newRow Is Nothing Then
        Err.Raise Number:=vbObjectError + 10011, Source:=Me.Name & ".Activate", Description:="Impossible d'ajouter une nouvelle ligne."
    End If
    
    With newRow
        .Range(table.ListColumns(GlobalConst.CLIENTS_LAST_NAME).index).value = "Térieur"
        .Range(table.ListColumns(GlobalConst.CLIENTS_FIRST_NAME).index).value = "Alex"
        '...
        '...
        '...
    End With

    
    
Catch:
    If Err.Number <> 0 Then
        'ToDo "Make something."
        MsgBox "Oupss... Nous avons rencontré l'erreur : " & Err.Number - vbObjectError & " Dans " & Err.Source & vbNewLine & Err.Description, vbMsgBoxHelpButton, "Erreur !"
        Err.Clear
        '...
        '...
    End If