Option Explicit

Private Const CODEPAGE_1252 As Integer = 1252

' Rapport d'erreurs global
Dim sortedReport As String

' Variables globales pour stocker les erreurs
Dim contributorInitialsErrors As String
Dim dateErrors As String
Dim dateFormatErrors As String
Dim dateFormatPersonErrors As String
Dim dateProductionFormatErrors As String
Dim duplicateDataErrors As String
Dim duplicateIdErrors As String
Dim editeurImprimeurErrors As String
Dim fileNotFoundErrors As String
Dim formatErrors As String
Dim formattingErrors As String
Dim hyphensErrors As String
Dim idReferenceErrors As String
Dim missingIDErrors As String
Dim misspelledErrors As String
Dim multipleIDFormatErrors As String
Dim nameExistsErrors As String
Dim nameFormatErrors As String
Dim nameMatchingErrors As String
Dim numericErrors As String
Dim periodValidationErrors As String
Dim prefixErrors As String
Dim restrictedValueErrors As String
Dim reverseErrors As String
Dim spaceErrors As String
Dim urlErrors As String
Dim valueValidationErrors As String
Dim yearFormatErrors As String
Dim identifiantComment As String
Dim locationDateErrors As String
Dim eventDateErrors As String
Dim colPositionErrors As String, extraColumnErrors As String
Dim capitalizationErrors As String, mispelledColumnErrors As String
Dim linebreakErrors As String, correspondenceErrors As String
Dim extraSpacesErrors As String
Dim columnErrorReport As String

' Pour garder les noms et prénoms en vue correction orthographique
Dim properNamesDict As Object

Function GenerateSortedColumnErrorReport() As String
    If mispelledColumnErrors <> "" Then columnErrorReport = columnErrorReport & "Colonnes mal orthographiées :" & vbCrLf & mispelledColumnErrors & vbCrLf
    If capitalizationErrors <> "" Then columnErrorReport = columnErrorReport & "Erreurs de majuscule/minuscule :" & vbCrLf & capitalizationErrors & vbCrLf
    If extraColumnErrors <> "" Then columnErrorReport = columnErrorReport & "Colonnes supplémentaires :" & vbCrLf & extraColumnErrors & vbCrLf
    If linebreakErrors <> "" Then columnErrorReport = columnErrorReport & "Erreurs de sauts de ligne :" & vbCrLf & linebreakErrors & vbCrLf
    If colPositionErrors <> "" Then columnErrorReport = columnErrorReport & "Colonnes à ajouter :" & vbCrLf & colPositionErrors & vbCrLf
    If extraSpacesErrors <> "" Then columnErrorReport = columnErrorReport & "Colonnes avec des espaces en trop :" & vbCrLf & extraSpacesErrors & vbCrLf
    If correspondenceErrors <> "" Then columnErrorReport = columnErrorReport & "Mauvaise correspondance :" & vbCrLf & correspondenceErrors & vbCrLf

    GenerateSortedColumnErrorReport = columnErrorReport
End Function

Function GenerateSortedErrorReport() As String
    Dim finalReport As String
    finalReport = sortedReport

    ' Append each category of errors to the final report
    If duplicateIdErrors <> "" Then finalReport = finalReport & "Erreurs d'ID dupliqués :" & vbCrLf & duplicateIdErrors & vbCrLf
    If duplicateDataErrors <> "" Then finalReport = finalReport & "Erreurs de doublons :" & vbCrLf & duplicateDataErrors & vbCrLf
    If dateFormatErrors <> "" Then finalReport = finalReport & "Erreurs de format de date :" & vbCrLf & dateFormatErrors & vbCrLf
    If dateProductionFormatErrors <> "" Then finalReport = finalReport & "Erreurs de format de date :" & vbCrLf & dateProductionFormatErrors & vbCrLf
    If dateFormatPersonErrors <> "" Then finalReport = finalReport & "Erreurs de date dans la feuille Personne" & vbCrLf & dateFormatPersonErrors & vbCrLf
    If prefixErrors <> "" Then finalReport = finalReport & "Erreurs de préfixe :" & vbCrLf & prefixErrors & vbCrLf
    If valueValidationErrors <> "" Then finalReport = finalReport & "Erreurs de validation de valeur :" & vbCrLf & valueValidationErrors & vbCrLf
    If idReferenceErrors <> "" Then finalReport = finalReport & "Erreurs de référence des identifiants :" & vbCrLf & idReferenceErrors & vbCrLf
    If nameFormatErrors <> "" Then finalReport = finalReport & "Erreurs de format de nom :" & vbCrLf & nameFormatErrors & vbCrLf
    If nameExistsErrors <> "" Then finalReport = finalReport & "Erreurs de noms inexistants dans PERSONNE :" & vbCrLf & nameExistsErrors & vbCrLf
    If nameMatchingErrors <> "" Then finalReport = finalReport & "Erreurs de correspondance des noms :" & vbCrLf & nameMatchingErrors & vbCrLf
    If contributorInitialsErrors <> "" Then finalReport = finalReport & "Erreurs des initiales du contributeur :" & vbCrLf & contributorInitialsErrors & vbCrLf
    If editeurImprimeurErrors <> "" Then finalReport = finalReport & "Erreurs de correspondance éditeur/imprimeur :" & vbCrLf & editeurImprimeurErrors & vbCrLf
    If formattingErrors <> "" Then finalReport = finalReport & "Erreurs de format général :" & vbCrLf & formattingErrors & vbCrLf
    If periodValidationErrors <> "" Then finalReport = finalReport & "Erreurs de validation des périodes :" & vbCrLf & periodValidationErrors & vbCrLf
    If missingIDErrors <> "" Then finalReport = finalReport & "Erreur identifiant n'est pas créé :" & vbCrLf & missingIDErrors & vbCrLf
    If spaceErrors <> "" Then finalReport = finalReport & "Erreurs d'espaces multiples détectés :" & vbCrLf & spaceErrors & vbCrLf
    If reverseErrors <> "" Then finalReport = finalReport & "Erreurs de relations inverses manquantes :" & vbCrLf & reverseErrors & vbCrLf
    If fileNotFoundErrors <> "" Then finalReport = finalReport & "Erreurs de fichiers non trouvés :" & vbCrLf & fileNotFoundErrors & vbCrLf
    If urlErrors <> "" Then finalReport = finalReport & "Erreurs d'URL :" & vbCrLf & urlErrors & vbCrLf
    If numericErrors <> "" Then finalReport = finalReport & "Erreur : la valeur n'est pas numérique: " & vbCrLf & numericErrors & vbCrLf
    If misspelledErrors <> "" Then finalReport = finalReport & "Erreur : faute d'orthographe : " & vbCrLf & misspelledErrors & vbCrLf
    If yearFormatErrors <> "" Then finalReport = finalReport & "Erreur : le format de l'année est incorrect: " & vbCrLf & yearFormatErrors & vbCrLf
    If restrictedValueErrors <> "" Then finalReport = finalReport & "Erreur : les valeurs ne sont pas reconnues: " & vbCrLf & restrictedValueErrors & vbCrLf
    If dateErrors <> "" Then finalReport = finalReport & "Erreur : les dates sont incorrectes : " & vbCrLf & dateErrors & vbCrLf
    If formatErrors <> "" Then finalReport = finalReport & "Erreur de format d'identifiant : " & vbCrLf & formatErrors & vbCrLf
    If hyphensErrors <> "" Then finalReport = finalReport & "Erreur de trait d'union : " & vbCrLf & hyphensErrors & vbCrLf
    If identifiantComment <> "" Then finalReport = finalReport & "Identifiant détecté : " & vbCrLf & identifiantComment & vbCrLf

    GenerateSortedErrorReport = finalReport
End Function

Sub ValidateAllSheets()
    Dim wbModel     As Workbook
    Dim wbData      As Workbook
    Dim wsData      As Worksheet
    Dim wsModel     As Worksheet
    Dim sheetName   As String
    Dim modelFile   As Variant        ' Must be Variant to handle False
    Dim dataFile    As Variant        ' Must be Variant to handle False
    Dim reportFile  As String
    Dim columnsValid As Boolean
    Dim contributorInitialsCol As Long
    Dim columnNames As Variant
    Dim validType   As Variant
    Dim validType1  As Variant
    Dim validGenreMusical As Variant
    Dim validPliage As Variant
    Dim validMusical As Variant
    Dim validGenre  As Variant
    Dim wsSourceManuscrite As Worksheet
    Dim wsSourceImprimee As Worksheet
    Dim wsPersonne  As Worksheet
    Dim wsOeuvre    As Worksheet
    Dim wsLieu      As Worksheet
    Dim wsCollectivite As Worksheet
    Dim wsDepot     As Worksheet
    Dim wsEvenement As Worksheet
    Dim folderPath  As String
    Dim fileColumnManuscrite As Range
    Dim fileColumnImprimee As Range        ' Define fileColumnImprimee as a Range
    Dim lastRowManuscrite As Long
    Dim lastRowImprimee As Long
    Dim fileName    As String
    Dim i           As Long
    Dim dotPosition As Long
    Dim detailedReport As String
    ' --- Variables à ajouter ---
    Dim pdfDestinationPath As String
    Dim columnsToCheck As Variant
    Dim fileColumn As Range
    Dim lastRow As Long
    Dim cellValue As String
    Dim columnName As Variant
    Dim fileNotFoundErrors As String
    Dim fullFilePath As String
    Dim fso As Object
    Dim sortedReport As String
    Dim reportFilePath As String  ' Renommé pour éviter la duplication
    ' ------------------------------
    

    dataFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Sélectionnez le fichier de données")
    If dataFile = False Or dataFile = "" Then Exit Sub

    Set wbModel = ThisWorkbook
    Set wbData = Workbooks.Open(dataFile)

    columnErrorReport = "Rapport de validation des données :" & vbCrLf & vbCrLf
    columnsValid = True

    For Each wsData In wbData.Sheets
        sheetName = wsData.name
        On Error Resume Next
        Set wsModel = wbModel.Sheets(sheetName)
        On Error GoTo 0

        If Not wsModel Is Nothing Then
            If Not ValidateColumnsWithReport(wsData, wsModel) Then columnsValid = False
        Else
            columnErrorReport = columnErrorReport & "Aucune feuille correspondante trouvée dans le fichier modèle pour '" & sheetName & "'." & vbCrLf
            columnsValid = False
        End If
    Next wsData

    columnErrorReport = GenerateSortedColumnErrorReport()

    If Not columnsValid Then
        reportFilePath = ThisWorkbook.Path & "\" & Left(ThisWorkbook.name, InStrRev(ThisWorkbook.name, ".") - 1) & "_rapport_erreur.txt"
        Open reportFilePath For Output As #1
        Print #1, columnErrorReport
        Close #1
        MsgBox "Le rapport d'erreurs a été généré : " & reportFilePath, vbInformation

    Else

    ' Si les colonnes sont valides, continuer avec les autres validations

    sortedReport = "Rapport de validation des données :" & vbCrLf & vbCrLf
    
    ' Initialiser les références des feuilles
    On Error Resume Next
    Set wsSourceManuscrite = wbData.Sheets("SOURCE MANUSCRITE")
    Set wsSourceImprimee = wbData.Sheets("SOURCE IMPRIMEE")
    Set wsPersonne = wbData.Sheets("PERSONNE")
    Set wsOeuvre = wbData.Sheets("OEUVRE")
    Set wsLieu = wbData.Sheets("LIEU")
    Set wsCollectivite = wbData.Sheets("COLLECTIVITÉ")
    Set wsDepot = wbData.Sheets("DÉPÔT")
    Set wsEvenement = wbData.Sheets("EVENEMENT")
    On Error GoTo 0

    
    ' Initialize Dictionary for Proper Names
    Set properNamesDict = CreateObject("Scripting.Dictionary")
    Call PopulateProperNamesDictionary(wsPersonne)
    

    ' Boucler sur chaque feuille du fichier de données
    For Each wsData In wbData.Sheets
        sheetName = wsData.name
        
        ' Appelez CleanSheet pour nettoyer les espaces
        Call CleanSheet(wsData)
        
        ' Ajoutez les erreurs d'espaces au rapport trié
        ' If spaceErrors <> "" Then
        '    sortedReport = sortedReport & spaceErrors & vbCrLf
        ' End If
        
        ' Utiliser Select Case pour effectuer des validations spécifiques en fonction du nom de la feuille
        Select Case sheetName
            Case "SOURCE MANUSCRITE"

                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "arch")
                
                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Personne (Optionnel)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Evénement (Optionnel)", wsEvenement, "ID", "event")
                Call CleanAndValidate(wsData, "ID Oeuvre (Optionnel)", wsOeuvre, "ID", "work")
                Call CleanAndValidate(wsData, "ID Source manuscrite (optionnel)", wsSourceManuscrite, "ID", "arch")
                Call CleanAndValidate(wsData, "ID Source imprimée (optionnel)", wsSourceImprimee, "ID", "print")
                Call CleanAndValidate(wsData, "ID Dépôt", wsDepot, "ID", "repo")
                Call CleanAndValidate(wsData, "ID Collectivité", wsCollectivite, "ID", "group")

                                
                ' 3 - Specifics
                Call ValidatePublicationOrProductionDate(wsData, "Date de production", False)
                Call ValidatePublicationOrProductionDate(wsData, "Date de modification" & Chr(10) & "(dernière révision dans le cas de retouches multiples)", False)
                Call ValidateURLs(wsData, "Lien hypertexte vers notice de l'exemplaire consulté" & Chr(10) & "(uniquement permalien)")
                Call ValidateURLs(wsData, "Lien hypertexte vers la numérisation en ligne si elle existe")
                Call ValidateRestrictedValues(wsData, "Type" & Chr(10) & "(valeurs restreintes)")
                
                columnNames = Array("Titre ou [Titre forgé] (graphie moderne)", "Date de production", "Référence (cote)", "Nom du fichier")
                Call CheckForDuplicates(wsData, columnNames)
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")
                
                
            Case "PERSONNE"
                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "person")

                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Personnes en relation (optionnel)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Collectivité", wsCollectivite, "ID", "group")

                ' 3 - Specifics
                Call ValidateDates(wsData, "Date de naissance", "Date de décès")
                Call ValidateURLs(wsData, "URL référentiel de la France d'Ancien Régime (complété par Nathalie)")
                Call ValidateURLs(wsData, "URI ou identifiant externe vers identifiant numérique universel (data.bnf ou Idref )")
                Call ValidateReversePersonRelationships(wsData, "ID", "ID Personnes en relation (optionnel)")
                Call ValidateRestrictedValues(wsData, "Genre")
                Call CheckHyphensInPrenom(wsData)
                
                columnNames = Array("Nom", "Prénom", "ID Personne (Optionnel)", "ID Collectivité", "Date de naissance", "Lieu de naissance", "Date de décès", "Lieu de décès")
                Call CheckForDuplicates(wsData, columnNames)
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")

            Case "OEUVRE"
                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "work")
                
                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Personne (Auteur ou arrangeur du texte)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Personne (Compositeur ou arrangeur de la musique)", wsPersonne, "ID", "person")
                
                ' 3 - Specifics
                Call ValidatePublicationOrProductionDate(wsData, "Date de création ou publication", True)
                Call ValidateRestrictedValues(wsData, "Genre musical")
                Call ValidatePersonNames(wsOeuvre, wsPersonne, "Auteur ou arrangeur du texte (saisie libre)")
                Call ValidatePersonNames(wsOeuvre, wsPersonne, "Compositeur ou arrangeur de la musique (saisie libre)")
                
                columnNames = Array("Titre ou [Titre forgé] + sous-titre", "ID Personne (Auteur ou arrangeur du texte)", "Auteur ou arrangeur du texte (saisie libre)", "ID Personne (Compositeur ou arrangeur de la musique)", "Compositeur ou arrangeur de la musique (saisie libre)", "Date de création ou publication")
                Call CheckForDuplicates(wsData, columnNames)
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")

            Case "SOURCE IMPRIMEE"
                
                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "print")

                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Collectivité", wsCollectivite, "ID", "group")
                Call CleanAndValidate(wsData, "ID Personne (Optionnel)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Evénement (Optionnel)", wsEvenement, "ID", "event")
                Call CleanAndValidate(wsData, "ID Oeuvre (Optionnel)", wsOeuvre, "ID", "work")
                Call CleanAndValidate(wsData, "ID Source manuscrite (optionnel)", wsSourceManuscrite, "ID", "arch")
                Call CleanAndValidate(wsData, "ID Source imprimée (optionnel)", wsSourceImprimee, "ID", "print")
                Call CleanAndValidate(wsData, "ID Dépôt", wsDepot, "ID", "repo")
                
                ' 3 - Specifics
                Call ValidateYearFormat(wsSourceImprimee, "Année d'édition")
                
                Call ValidateURLs(wsSourceImprimee, "Lien hypertexte vers la numérisation en ligne si elle existe")
                Call ValidateURLs(wsSourceImprimee, "Lien hypertexte vers notice source" & Chr(10) & "(uniquement permalien)")
                
                Call ValidatePersonNames(wsSourceImprimee, wsPersonne, "Éditeur/Imprimeur")
                
                Call ValidateRestrictedValues(wsSourceImprimee, "Type")
                Call ValidateRestrictedValues(wsSourceImprimee, "Format réel =pliage" & Chr(10) & "(optionnel)")
                
                Call ValidateNumericValues(wsData, "Pagination (totale ou de l'extrait)")
                
                columnNames = Array("Titre ou [Titre forgé] + sous-titre", "Nom de fichier", "Référence (cote)", "Année d'édition", "Éditeur/Imprimeur")
                Call CheckForDuplicates(wsSourceImprimee, columnNames)

                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")

            Case "LIEU"

                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "place")

                ' 2 - CleanAndValidate
                
                ' 3 - Specifics
                Call ValidateDates(wsData, "Date de début" & Chr(10) & "(optionnel)", "Date de fin" & Chr(10) & "(optionnel)")
                Call CheckForDuplicates(wsData, Array("Label", "Terme générique", "Terme spécifique"))
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")
                
            Case "COLLECTIVITÉ"

                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "group")
                
                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Personnes en relation (optionnel)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Lieu", wsLieu, "ID", "place")
                
                ' 3 - Specifics
                Call ValidatePeriodColumn(wsData, "Période d'activité (Optionnel)")
                Call ValidateYearFormat(wsCollectivite, "Date de reconnaissance (optionnel)")
                Call ValidateURLs(wsCollectivite, "Lien Zotero")
                Call ValidateURLs(wsCollectivite, "IdRef" & Chr(10) & "(voir site https://www.idref.fr/)")
                Call ValidateRestrictedValues(wsData, "Musicale O/N")
                columnNames = Array("Label = Dénomination (+ période)", "Type", "Lien Zotero", "Mentions auctoriales (rempli par Bénédicte)", "Auteur du dossier (rempli par Bénédicte)")
                Call CheckForDuplicates(wsCollectivite, columnNames)
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")
                
            Case "DÉPÔT"

                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "repo")
                
                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Collectivité", wsCollectivite, "ID", "group")
                
                ' 3 - Specifics
                Call ValidateURLs(wsDepot, "Lien hypertexte vers site web")
                
                columnNames = Array("Label" & Chr(10) & "(forme d'autorité - voir CCFR ou à défaut idref)", "Lien hypertexte vers site web", "Adresse")
                Call CheckForDuplicates(wsDepot, columnNames)
                
                
            Case "EVENEMENT"
                
                ' 1 - Validate IDs
                Call ValidateUniqueIDs(wsData, "ID", "event")
                
                ' 2 - CleanAndValidate
                Call CleanAndValidate(wsData, "ID Collectivité (optionnel)", wsCollectivite, "ID", "group")
                Call CleanAndValidate(wsData, "ID Personne (Optionnel)", wsPersonne, "ID", "person")
                Call CleanAndValidate(wsData, "ID Lieu", wsLieu, "ID", "place")
                Call CleanAndValidate(wsData, "ID Oeuvre (optionnel)", wsOeuvre, "ID", "work")
                Call CleanAndValidate(wsData, "ID Source manuscrite", wsSourceManuscrite, "ID", "arch")
                Call CleanAndValidate(wsData, "ID Source imprimée", wsSourceImprimee, "ID", "print")
                
                ' 3 - Specifics
                Call ValidateDates(wsData, "Date ou date de début", "Date de fin")
                
                Call CheckForDuplicates(wsData, Array("Titre", "Type - sous-type", "Date ou date de début", "Date de fin"))
                Call ValidateSpelling(wsData, "Commentaires publics")
                Call CheckIdentifiersInComments(wsData, "Commentaires publics")
                
            Case Else
                sortedReport = sortedReport & "Aucune validation spécifique pour la feuille '" & wsData.name & "'." & vbCrLf
        End Select
    Next wsData

   ' Demander à l'utilisateur de sélectionner le dossier contenant les fichiers PDF
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez le répertoire contenant les fichiers PDF"
        .InitialFileName = "" ' Assurez-vous qu'aucun dossier n'est proposé par défaut
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "Aucun répertoire sélectionné. Opération annulée."
            Exit Sub
        End If
    End With
    
    ' S'assurer que le chemin du dossier se termine par une barre oblique inverse
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' Créer un nouveau dossier "FilesPDF" dans le dossier où se trouve la macro
    pdfDestinationPath = ThisWorkbook.Path
    If Right(pdfDestinationPath, 1) <> "\" Then pdfDestinationPath = pdfDestinationPath & "\"
    pdfDestinationPath = pdfDestinationPath & "FilesPDF\"
    If Dir(pdfDestinationPath, vbDirectory) = "" Then
        MkDir pdfDestinationPath
    End If
    
    ' Créer l'objet FileSystemObject une seule fois
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' ---- Validation et copie des fichiers pour SOURCE MANUSCRITE ----
    If Not wsSourceManuscrite Is Nothing Then
        ' Colonnes à vérifier
        columnsToCheck = Array("Nom du fichier", "Transcription (optionnel)" & Chr(10) & "(nom du pdf)")
        For Each columnName In columnsToCheck
            Set fileColumn = wsSourceManuscrite.Rows(1).Find(What:=columnName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not fileColumn Is Nothing Then ' Vérifier si la colonne est trouvée
                lastRow = wsSourceManuscrite.Cells(wsSourceManuscrite.Rows.Count, fileColumn.Column).End(xlUp).Row
                For i = 2 To lastRow
                    cellValue = Trim(wsSourceManuscrite.Cells(i, fileColumn.Column).value)
                    If cellValue <> "" Then
                        ' S'assurer que le nom de fichier se termine par .pdf
                        If Not LCase(cellValue) Like "*.pdf" Then
                            cellValue = Replace(cellValue, ".pdf", "", , , vbTextCompare) ' Supprimer toute extension existante
                            fileName = cellValue & ".pdf" ' Ajouter l'extension .pdf
                        Else
                            fileName = cellValue
                        End If
    
                        ' Rechercher le fichier dans le dossier et ses sous-dossiers
                        fullFilePath = FindFileRecursively(fso, folderPath, fileName)
                        If fullFilePath = "" Then
                            fileNotFoundErrors = fileNotFoundErrors & "Le fichier '" & fileName & "' dans SOURCE MANUSCRITE (colonne '" & columnName & "') n'est pas trouvable dans le répertoire." & vbCrLf
                            wsSourceManuscrite.Cells(i, fileColumn.Column).Interior.Color = RGB(255, 0, 0) ' Mettre en évidence la cellule en rouge
                        Else
                            ' Copier le fichier PDF dans le dossier de destination
                            FileCopy fullFilePath, pdfDestinationPath & fileName
                        End If
                    End If
                Next i
            Else
                MsgBox "La colonne '" & columnName & "' n'a pas été trouvée dans SOURCE MANUSCRITE.", vbCritical
            End If
        Next columnName
    End If
    
    ' ---- Validation et copie des fichiers pour SOURCE IMPRIMÉE ----
    If Not wsSourceImprimee Is Nothing Then
        ' Colonnes à vérifier
        columnsToCheck = Array("Nom de fichier", "Transcription (optionnel)" & Chr(10) & "(nom du pdf)")
        For Each columnName In columnsToCheck
            Set fileColumn = wsSourceImprimee.Rows(1).Find(What:=columnName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not fileColumn Is Nothing Then ' Vérifier si la colonne est trouvée
                lastRow = wsSourceImprimee.Cells(wsSourceImprimee.Rows.Count, fileColumn.Column).End(xlUp).Row
                For i = 2 To lastRow
                    cellValue = Trim(wsSourceImprimee.Cells(i, fileColumn.Column).value)
                    If cellValue <> "" Then
                        ' S'assurer que le nom de fichier se termine par .pdf
                        If Not LCase(cellValue) Like "*.pdf" Then
                            cellValue = Replace(cellValue, ".pdf", "", , , vbTextCompare) ' Supprimer toute extension existante
                            fileName = cellValue & ".pdf" ' Ajouter l'extension .pdf
                        Else
                            fileName = cellValue
                        End If
    
                        ' Rechercher le fichier dans le dossier et ses sous-dossiers
                        fullFilePath = FindFileRecursively(fso, folderPath, fileName)
                        If fullFilePath = "" Then
                            fileNotFoundErrors = fileNotFoundErrors & "Le fichier '" & fileName & "' dans SOURCE IMPRIMÉE (colonne '" & columnName & "') n'est pas trouvable dans le répertoire." & vbCrLf
                            wsSourceImprimee.Cells(i, fileColumn.Column).Interior.Color = RGB(255, 0, 0) ' Mettre en évidence la cellule en rouge
                        Else
                            ' Copier le fichier PDF dans le dossier de destination
                            FileCopy fullFilePath, pdfDestinationPath & fileName
                        End If
                    End If
                Next i
            Else
                MsgBox "La colonne '" & columnName & "' n'a pas été trouvée dans SOURCE IMPRIMÉE.", vbCritical
            End If
        Next columnName
    End If
    
    ' ---- Validation et copie des fichiers pour COLLECTIVITÉ ----
    If Not wsCollectivite Is Nothing Then
        ' Colonnes à vérifier
        columnsToCheck = Array("Portrait d'académie au format pdf", "Pdf attaché (cachet)")
        For Each columnName In columnsToCheck
            Set fileColumn = wsCollectivite.Rows(1).Find(What:=columnName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not fileColumn Is Nothing Then
                lastRow = wsCollectivite.Cells(wsCollectivite.Rows.Count, fileColumn.Column).End(xlUp).Row
                For i = 2 To lastRow
                    cellValue = Trim(wsCollectivite.Cells(i, fileColumn.Column).value)
                    If cellValue <> "" Then
                        ' S'assurer que le nom de fichier se termine par .pdf
                        If Not LCase(cellValue) Like "*.pdf" Then
                            cellValue = Replace(cellValue, ".pdf", "", , , vbTextCompare) ' Supprimer toute extension existante
                            fileName = cellValue & ".pdf" ' Ajouter l'extension .pdf
                        Else
                            fileName = cellValue
                        End If
    
                        ' Rechercher le fichier dans le dossier et ses sous-dossiers
                        fullFilePath = FindFileRecursively(fso, folderPath, fileName)
                        If fullFilePath = "" Then
                            fileNotFoundErrors = fileNotFoundErrors & "Le fichier '" & fileName & "' dans COLLECTIVITÉ (colonne '" & columnName & "') n'est pas trouvable dans le répertoire." & vbCrLf
                            wsCollectivite.Cells(i, fileColumn.Column).Interior.Color = RGB(255, 0, 0) ' Mettre en évidence la cellule en rouge
                        Else
                            ' Copier le fichier PDF dans le dossier de destination
                            FileCopy fullFilePath, pdfDestinationPath & fileName
                        End If
                    End If
                Next i
            Else
                MsgBox "La colonne '" & columnName & "' n'a pas été trouvée dans COLLECTIVITÉ.", vbCritical
            End If
        Next columnName
    End If
    
    ' ---- Validation et copie des fichiers pour PERSONNE ----
    If Not wsPersonne Is Nothing Then
        ' Colonnes à vérifier
        columnsToCheck = Array("Portrait" & Chr(10) & "(optionnel)")
        For Each columnName In columnsToCheck
            Set fileColumn = wsPersonne.Rows(1).Find(What:=columnName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not fileColumn Is Nothing Then
                lastRow = wsPersonne.Cells(wsPersonne.Rows.Count, fileColumn.Column).End(xlUp).Row
                For i = 2 To lastRow
                    cellValue = Trim(wsPersonne.Cells(i, fileColumn.Column).value)
                    If cellValue <> "" Then
                        ' S'assurer que le nom de fichier se termine par .pdf
                        If Not LCase(cellValue) Like "*.pdf" Then
                            cellValue = Replace(cellValue, ".pdf", "", , , vbTextCompare) ' Supprimer toute extension existante
                            fileName = cellValue & ".pdf" ' Ajouter l'extension .pdf
                        Else
                            fileName = cellValue
                        End If
    
                        ' Rechercher le fichier dans le dossier et ses sous-dossiers
                        fullFilePath = FindFileRecursively(fso, folderPath, fileName)
                        If fullFilePath = "" Then
                            fileNotFoundErrors = fileNotFoundErrors & "Le fichier '" & fileName & "' dans PERSONNE (colonne '" & columnName & "') n'est pas trouvable dans le répertoire." & vbCrLf
                            wsPersonne.Cells(i, fileColumn.Column).Interior.Color = RGB(255, 0, 0) ' Mettre en évidence la cellule en rouge
                        Else
                            ' Copier le fichier PDF dans le dossier de destination
                            FileCopy fullFilePath, pdfDestinationPath & fileName
                        End If
                    End If
                Next i
            Else
                MsgBox "La colonne '" & columnName & "' n'a pas été trouvée dans PERSONNE.", vbCritical
            End If
        Next columnName
    End If
    
' Générer le rapport d'erreurs trié
If sortedReport <> "" Then
    detailedReport = GenerateSortedErrorReport()
    
    ' Le nom du fichier de rapport des erreurs est construit sur la base du nom du classeur actuel (ThisWorkbook)
    dotPosition = InStrRev(ThisWorkbook.name, ".")
    reportFile = ThisWorkbook.Path & "\" & Left(ThisWorkbook.name, dotPosition - 1) & "_rapport_erreur.txt"
    Open reportFile For Output As #1
    Print #1, detailedReport
    Close #1
    MsgBox "Le rapport d'erreurs a été généré : " & reportFile, vbInformation
  End If
End If

MsgBox "La validation est terminée et les fichiers PDF ont été copiés dans le dossier 'FilesPDF'.", vbInformation

' Appeler la procédure pour sauvegarder une copie avec les cellules mises en évidence
Call SaveHighlightedCopy(wbData)

' Fermer les classeurs
' wbModel.Close False
wbData.Close False

End Sub


Function FindFileRecursively(fso As Object, rootFolderPath As String, fileName As String) As String
    On Error GoTo ErrorHandler

    ' Normalize the root folder path
    rootFolderPath = NormalizeFolderPath(rootFolderPath)

    ' Check if the root folder exists
    If Not fso.FolderExists(rootFolderPath) Then
        FindFileRecursively = ""
        Exit Function
    End If

    ' Create a collection to act as a stack for folder paths
    Dim foldersToCheck As Collection
    Set foldersToCheck = New Collection
    foldersToCheck.Add rootFolderPath

    Dim currentFolderPath As String
    Dim currentFolder As Object
    Dim file As Object
    Dim subfolder As Object

    ' Loop through the collection while there are folders to check
    Do While foldersToCheck.Count > 0
        ' Get the next folder path to check
        currentFolderPath = foldersToCheck(1)
        foldersToCheck.Remove 1

        ' Get the folder object
        Set currentFolder = fso.GetFolder(currentFolderPath)

        ' Check each file in the current folder
        For Each file In currentFolder.Files
            If StrComp(fso.GetFileName(file.Path), fileName, vbTextCompare) = 0 Then
                FindFileRecursively = file.Path
                Exit Function
            End If
        Next file

        ' Add each subfolder in the current folder to the collection
        For Each subfolder In currentFolder.SubFolders
            foldersToCheck.Add subfolder.Path
        Next subfolder
    Loop

    ' File not found
    FindFileRecursively = ""
    Exit Function

ErrorHandler:
    ' Return empty string in case of an error
    FindFileRecursively = ""
End Function

' Function to normalize folder path
Function NormalizeFolderPath(folderPath As String) As String
    ' Trim any unnecessary spaces
    folderPath = Trim(folderPath)

    ' Ensure folder path ends with a backslash
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If

    NormalizeFolderPath = folderPath
End Function


Function ValidateColumnsWithReport(wsData As Worksheet, wsModel As Worksheet) As Boolean
    Dim lastColData As Long, lastColModel As Long, maxCol As Long
    Dim i As Long
    Dim colNameData As String, colNameModel As String
    Dim cleanedColNameData As String, cleanedColNameModel As String
    Dim isValid As Boolean

    
    ' Initialize isValid to True
    isValid = True
    
    ' Initialize error messages
    colPositionErrors = ""
    extraColumnErrors = ""
    capitalizationErrors = ""
    mispelledColumnErrors = ""
    linebreakErrors = ""
    correspondenceErrors = ""
    extraSpacesErrors = ""
    
    ' Find the last column in both sheets
    lastColData = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    lastColModel = wsModel.Cells(1, wsModel.Columns.Count).End(xlToLeft).Column
    
    ' Determine the maximum number of columns to compare
    maxCol = Application.WorksheetFunction.Max(lastColData, lastColModel)
    
    ' Compare columns based on their position
    For i = 1 To maxCol
        colNameModel = ""
        colNameData = ""
        cleanedColNameModel = ""
        cleanedColNameData = ""
        
        ' Get column names from model and data
        If i <= lastColModel Then
            colNameModel = wsModel.Cells(1, i).value
            cleanedColNameModel = CleanString(colNameModel, False)
        End If
        
        If i <= lastColData Then
            colNameData = wsData.Cells(1, i).value
            cleanedColNameData = CleanString(colNameData, False)
        End If
        
        ' Check for line breaks (Chr(10)) in column names in both sheets
        If InStr(colNameData, Chr(10)) > 0 Or InStr(colNameModel, Chr(10)) > 0 Then
            If colNameData = colNameModel Then
                ' No error if line breaks match exactly between model and data
            Else
                linebreakErrors = linebreakErrors & "Erreur de saut de ligne : La colonne '" & colNameData & "' contient des sauts de ligne par rapport à '" & colNameModel & "' dans la feuille '" & wsData.name & "'." & vbCrLf
                isValid = False
            End If
        ' Check for extra spaces (leading, trailing, or double spaces)
        ElseIf colNameData <> "" And (colNameData <> Trim(colNameData) Or InStr(colNameData, "  ") > 0) Then
            extraSpacesErrors = extraSpacesErrors & "Erreur : La colonne '" & colNameData & "' dans la feuille '" & wsData.name & "' contient des espaces en trop." & vbCrLf
            isValid = False
        ' Column name comparison
        ElseIf colNameModel <> "" And colNameData <> "" Then
            If colNameData <> colNameModel Then
                Dim colNameDataNoLineBreaks As String
                Dim colNameModelNoLineBreaks As String
                
                colNameDataNoLineBreaks = CleanString(colNameData, True)
                colNameModelNoLineBreaks = CleanString(colNameModel, True)
                
                ' Handle capitalization and spelling errors
                If StrComp(colNameDataNoLineBreaks, colNameModelNoLineBreaks, vbTextCompare) = 0 Then
                    capitalizationErrors = capitalizationErrors & "Erreur de majuscule : La colonne '" & colNameData & "' devrait être '" & colNameModel & "' dans la feuille '" & wsData.name & "'." & vbCrLf
                ElseIf IsMispelled(colNameData, colNameModel) Then
                    mispelledColumnErrors = mispelledColumnErrors & "Erreur d'orthographe : La colonne '" & colNameData & "' ne correspond pas à '" & colNameModel & "' dans la feuille '" & wsData.name & "'." & vbCrLf
                Else
                    correspondenceErrors = correspondenceErrors & "Erreur de correspondance : La colonne '" & colNameData & "' ne correspond pas à '" & colNameModel & "' dans la feuille '" & wsData.name & "'." & vbCrLf
                End If
                isValid = False
            End If
        ' Handle extra and missing columns
        ElseIf colNameModel = "" And colNameData <> "" Then
            extraColumnErrors = extraColumnErrors & "Erreur colonne supplémentaire : La colonne " & ColumnLetter(i) & " intitulée '" & colNameData & "' est une colonne supplémentaire dans la feuille '" & wsData.name & "'. Elle doit être supprimée." & vbCrLf
            isValid = False
        ElseIf colNameModel <> "" And colNameData = "" Then
            colPositionErrors = colPositionErrors & "Erreur : La colonne " & ColumnLetter(i) & " intitulée '" & colNameModel & "' est manquante dans la feuille '" & wsData.name & "'. Elle doit être ajoutée." & vbCrLf
            isValid = False
        End If
    Next i
   
    
    ' Return the validation result
    ValidateColumnsWithReport = isValid
End Function




Function IsMispelled(colNameData As String, colNameModel As String) As Boolean
    ' Définir un seuil de similarité pour considérer que les noms sont mal orthographiés
    Const SIMILARITY_THRESHOLD As Integer = 2
    IsMispelled = (LevenshteinDistance(colNameData, colNameModel) <= SIMILARITY_THRESHOLD)
End Function

Function LevenshteinDistance(s1 As String, s2 As String) As Integer
    Dim i As Integer, j As Integer
    Dim cost As Integer
    Dim d() As Integer
    Dim m As Integer, n As Integer
    
    m = Len(s1)
    n = Len(s2)
    
    ReDim d(0 To m, 0 To n)
    
    For i = 0 To m
        d(i, 0) = i
    Next i
    For j = 0 To n
        d(0, j) = j
    Next j
    
    For i = 1 To m
        For j = 1 To n
            If Mid(s1, i, 1) = Mid(s2, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If
            d(i, j) = WorksheetFunction.Min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
        Next j
    Next i
    
    LevenshteinDistance = d(m, n)
End Function



Function ColumnLetter(ByVal colNum As Long) As String
    ' Fonction pour obtenir la lettre de colonne à partir du numéro de colonne
    ColumnLetter = Split(Cells(1, colNum).Address(True, False), "$")(0)
End Function

Sub ValidateURLs(ByVal ws As Worksheet, ByVal urlColumn As String)
    Dim lastRow As Long, i As Long
    Dim colNum As Long, urlValue As String
    Dim regexUrl As Object
    Dim http As Object
    Set regexUrl = CreateObject("VBScript.RegExp")
    
    ' Basic regex for general URL validation
    regexUrl.pattern = "^https?://[^\s]+$"
    regexUrl.IgnoreCase = True
    
    ' Get column number for specified column
    colNum = GetColumnNumbers(ws, urlColumn)
    If colNum = -1 Then
        urlErrors = urlErrors & "Erreur ValidateURLs : La colonne '" & urlColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Loop to check URLs in the sheet
    lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row
    For i = 2 To lastRow
        urlValue = Trim(ws.Cells(i, colNum).value)
        
        ' Skip empty cells
        If urlValue <> "" Then
            ' Check if the value is a valid URL
            If Not regexUrl.Test(urlValue) Then
                ws.Cells(i, colNum).Interior.Color = RGB(255, 0, 0)
                urlErrors = urlErrors & "Erreur : La valeur '" & urlValue & "' à la ligne " & i & " dans la colonne '" & urlColumn & "' n'est pas une URL valide." & vbCrLf
            Else
                ' Check if the URL is reachable
                Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
                On Error Resume Next
                http.Open "GET", urlValue, False
                http.Send
                On Error GoTo 0
                
                ' If status is 404 or content indicates "Not Found," flag as unreachable
                If http.Status = 404 Or http.responseText = "" Or InStr(http.responseText, "Not Found") > 0 Then
                    ws.Cells(i, colNum).Interior.Color = RGB(255, 165, 0) ' Orange for unreachable URL
                    urlErrors = urlErrors & "Erreur : L'URL '" & urlValue & "' à la ligne " & i & " dans la colonne '" & urlColumn & "' est introuvable (Not Found)." & vbCrLf
                End If
            End If
        End If
    Next i
End Sub

Function CleanString(ByVal inputStr As String, Optional removeLineBreaks As Boolean = True) As String
    ' Remove leading/trailing spaces and non-printable characters
    CleanString = Trim(inputStr)
    ' Optionally remove line breaks and other non-printable characters
    If removeLineBreaks Then
        ' Remove tabs and other non-printable characters
        CleanString = Application.WorksheetFunction.Clean(CleanString)
    End If
End Function

Function CleanReplaceNonPrintable(text As String) As String
    Dim i As Long
    Dim charCode As Integer
    Dim charArray() As String
    
    ' Check if the text is empty
    If Len(text) = 0 Then
        CleanReplaceNonPrintable = ""
        Exit Function
    End If
    
    ReDim charArray(1 To Len(text)) ' Pre-allocate an array for each character

    ' Loop through each character in the text
    For i = 1 To Len(text)
        charCode = Asc(Mid(text, i, 1))
        
        ' If the ASCII code is less than 32, replace with space
        If charCode < 32 Then
            charArray(i) = " "
        Else
            charArray(i) = Mid(text, i, 1)
        End If
    Next i

    ' Join the array into a single string
    CleanReplaceNonPrintable = Join(charArray, "")
End Function


Function CleanReplaceNonPrintableWithDiacritics(text As String) As String
    Dim i As Long, destIndex As Long
    Dim charArray() As String
    Dim charCode As Integer
    
    ' Check if the text is empty
    If Len(text) = 0 Then
        CleanReplaceNonPrintable = ""
        Exit Function
    End If
    
    ReDim charArray(1 To Len(text)) ' Pre-allocate an array for each character

    ' Initialize destination index
    destIndex = 1

    ' Loop through each character in the source text
    For i = 1 To Len(text)
        Dim currentChar As String
        currentChar = Mid(text, i, 1)
        charCode = Asc(currentChar)
        
        ' If the ASCII code is less than 32, replace with space
        If charCode < 32 Then
            charArray(destIndex) = " "
            GoTo NextChar
        End If
            
        ' Replace ASCII-based approximations of French diacritics with actual diacritics
        If i < Len(text) Then
        
            If StrComp(Mid(text, i, 2), "a^", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "â"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "e^", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ê"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "i^", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "î"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "o^", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ô"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "u^", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "û"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "a`", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "à"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "e`", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "è"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "u`", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ù"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "e´", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "é"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "a:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ä"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "e:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ë"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "i:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ï"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "o:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ö"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "u:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ü"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "y:", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ÿ"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            ElseIf StrComp(Mid(text, i, 2), "c,", vbBinaryCompare) = 0 Then
                charArray(destIndex) = "ç"
                i = i + 1 ' Skip the next character (^)
                GoTo NextChar
            End If
        End If
        ' Default case
        charArray(destIndex) = currentChar
NextChar:
        ' Increment the destination index
        destIndex = destIndex + 1
    Next i

    ' Resize the array to only the populated portion
    ReDim Preserve charArray(1 To destIndex - 1)

    ' Join the array into a single string
    CleanReplaceNonPrintable = Join(charArray, "")
End Function


Function GetColumnNumbers(ws As Worksheet, columnName As String) As Long
    Dim headerRow   As Range
    Dim cell        As Range
    Dim cleanColumnName As String
    Dim cleanCellValue As String
    
    ' Clean the target column name (remove spaces, line breaks, and non-printable characters)
    cleanColumnName = CleanString(columnName)
    
    ' Set the header row (assumed to be the first row)
    Set headerRow = ws.Rows(1)
    
    ' Loop through each cell in the header row to find the matching column
    For Each cell In headerRow.Cells
        If IsEmpty(cell.value) Then Exit For        ' Exit if we reach empty cells
        cleanCellValue = CStr(cell.value)
        cleanCellValue = CleanString(CStr(cell.value))
        
        ' Compare the cleaned column names (case-insensitive)
        If StrComp(cleanCellValue, cleanColumnName, vbTextCompare) = 0 Then
            GetColumnNumbers = cell.Column
            Exit Function
        End If
    Next cell
    
    ' Return -1 if the column is not found
    GetColumnNumbers = -1
End Function


Sub CheckForDuplicates(ws As Worksheet, columnNames As Variant)
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim key As String
    Dim dict As Object
    Dim colNums() As Long
    Dim idx As Long
    Dim allEmpty As Boolean
    Dim duplicateRows As Collection
    Dim rowNum As Variant
    Static markedRows As Object

    ' Initialize the dictionary and collection
    Set dict = CreateObject("Scripting.Dictionary")
    Set duplicateRows = New Collection
    If markedRows Is Nothing Then Set markedRows = CreateObject("Scripting.Dictionary")

    ' Find the last used row
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    ' Get the column numbers for each specified column name
    ReDim colNums(LBound(columnNames) To UBound(columnNames))
    For idx = LBound(columnNames) To UBound(columnNames)
        colNums(idx) = GetColumnNumbers(ws, CStr(columnNames(idx)))
       
        ' Ensure the columns are detected
        If colNums(idx) = -1 Then Exit Sub
    Next idx

    ' Loop through each row to check for duplicates
    For i = 2 To lastRow
        key = ""
        allEmpty = True

        ' Build a unique key based on the specified columns
        For j = LBound(colNums) To UBound(colNums)
            Dim cellValue As String
            cellValue = LCase(Trim(Replace(CStr(ws.Cells(i, colNums(j)).value), "  ", " ")))
            key = key & "|" & cellValue
            If cellValue <> "" Then
                allEmpty = False
            End If
        Next j

        ' Skip rows where all values are empty
        If allEmpty Then GoTo NextRow

        ' Check if the key already exists in the dictionary
        If dict.Exists(key) Then
            If Not markedRows.Exists(i) Then
                duplicateRows.Add Array(i, dict(key)) ' Add both rows as duplicates
                markedRows.Add i, True
                If Not markedRows.Exists(dict(key)) Then
                    markedRows.Add dict(key), True ' Mark the original duplicate as well
                End If
            End If
        Else
            dict.Add key, i
        End If
NextRow:
    Next i

    ' If duplicates are found
    If duplicateRows.Count > 0 Then
        ' Add errors to the report and highlight both duplicate rows
        Dim dupRow As Variant
        For Each dupRow In duplicateRows
            ' Highlight both rows in the duplicate pair
            ws.Rows(dupRow(0)).Interior.Color = RGB(255, 0, 0)
            ws.Rows(dupRow(1)).Interior.Color = RGB(255, 0, 0)
            
            ' Add to error report
            duplicateDataErrors = duplicateDataErrors & "Ligne " & dupRow(0) & " et Ligne " & dupRow(1) & " de la feuille """ & ws.name & """ sont des doublons. Il est nécessaire d'en supprimer un." & vbCrLf
        Next dupRow
    End If
End Sub

Sub ValidateDates(ByVal ws As Worksheet, startDateColumn As String, endDateColumn As String)
    Dim lastRow As Long, i As Long
    Dim startDate As String, endDate As String
    Dim startDateColNum As Long, endDateColNum As Long
    Dim startYear As Variant, endYear As Variant

    ' Obtenir les numéros de colonne pour les dates de début et de fin
    startDateColNum = GetColumnNumbers(ws, startDateColumn)
    endDateColNum = GetColumnNumbers(ws, endDateColumn)

    ' Vérifier si les colonnes existent
    If startDateColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & startDateColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If

    If endDateColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & endDateColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If

    ' Trouver la dernière ligne avec des données
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    ' Boucle pour valider les dates de début et de fin
    For i = 2 To lastRow
        startDate = Trim(ws.Cells(i, startDateColNum).value)
        endDate = Trim(ws.Cells(i, endDateColNum).value)

        ' Ignorer si les deux dates sont vides
        If startDate = "" And endDate = "" Then GoTo NextRow

        ' Valider la date de début en utilisant CheckDate
        If startDate <> "" Then
            startYear = CheckDate(startDate, allowRelative:=False, yearOnly:=False)
            If IsError(startYear) Then
                dateFormatErrors = dateFormatErrors & "Erreur : La Date de début '" & startDate & "' à la ligne " & i & " n'est pas valide dans la feuille '" & ws.name & "'." & vbCrLf
                ws.Cells(i, startDateColNum).Interior.Color = RGB(255, 0, 0)
            End If
        Else
            startYear = CVErr(xlErrValue)
        End If

        ' Valider la date de fin en utilisant CheckDate
        If endDate <> "" Then
            endYear = CheckDate(endDate, allowRelative:=False, yearOnly:=False)
            If IsError(endYear) Then
                dateFormatErrors = dateFormatErrors & "Erreur : La Date de fin '" & endDate & "' à la ligne " & i & " n'est pas valide dans la feuille '" & ws.name & "'." & vbCrLf
                ws.Cells(i, endDateColNum).Interior.Color = RGB(255, 0, 0)
            End If
        Else
            endYear = CVErr(xlErrValue)
        End If

        ' Vérifier si les deux dates sont valides avant de comparer
        If Not IsError(startYear) And Not IsError(endYear) Then
            ' Vérifier si l'année de début est postérieure à l'année de fin
            If startYear > endYear Then
                dateErrors = dateErrors & "Erreur : L'année de début (" & startYear & ") est après l'année de fin (" & endYear & ") à la ligne " & i & " dans la feuille '" & ws.name & "'." & vbCrLf
                ws.Cells(i, startDateColNum).Interior.Color = RGB(255, 0, 0)
                ws.Cells(i, endDateColNum).Interior.Color = RGB(255, 0, 0)
            End If
        End If
NextRow:
    Next i
End Sub




Sub ValidatePublicationOrProductionDate(ByVal ws As Worksheet, ByVal dateColumn As String, ByVal allowRelative As Boolean)
    Dim lastRow As Long, i As Long
    Dim colNumber As Long
    Dim dateValue As String, colLetter As String
    
    ' Find the last row of data
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' Get column number for the date column
    colNumber = GetColumnNumbers(ws, dateColumn)
    If colNumber = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & dateColumn & "' n'a pas été trouvée dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Get column letter for date column
    colLetter = Split(ws.Cells(1, colNumber).Address(True, False), "$")(1)
    
    ' Loop through each row to validate the date
    For i = 2 To lastRow
        dateValue = ws.Cells(i, colNumber).value
        
        ' Skip empty values
        If dateValue = "" Then GoTo NextRow
        
        ' Check for valid formats
        If IsError(CheckDate(dateValue)) Then
                ' Report invalid date format
                dateProductionFormatErrors = dateProductionFormatErrors & "Erreur : La valeur '" & dateValue & "' dans la feuille '" & ws.name & "', ligne " & i & ", colonne " & colLetter & " n'est pas au format date valide." & vbCrLf
                ' Highlight invalid cell in red
                ws.Cells(i, colNumber).Interior.Color = RGB(255, 0, 0)
        End If
        
NextRow:
    Next i
    
End Sub

Function CheckDate(ByVal dateStr As String, Optional allowRelative As Boolean = True, Optional yearOnly As Boolean = False) As Variant
    Dim regexYear As Object, regexMonthYear As Object, regexFullDate As Object
    Dim yearStr As String

    ' Nettoyer la chaîne de date
    dateStr = CleanReplaceNonPrintable(dateStr)
    dateStr = Trim(dateStr)
    dateStr = NormalizeSpaces(dateStr)
    dateStr = LCase(dateStr)

    ' Supprimer les préfixes et suffixes relatifs s'ils sont autorisés
    If allowRelative Then
        dateStr = RemovePrefixesAndSuffixes(dateStr)
    End If

    ' Re-normaliser les espaces après suppression des préfixes/suffixes
    dateStr = NormalizeSpaces(dateStr)

    ' Créer les objets RegExp
    Set regexYear = CreateObject("VBScript.RegExp")
    regexYear.pattern = "^\d{4}$" ' Année seulement : YYYY
    regexYear.Global = False

    Set regexMonthYear = CreateObject("VBScript.RegExp")
    regexMonthYear.pattern = "^\d{1,2}/\d{4}$" ' Mois/Année : MM/YYYY
    regexMonthYear.Global = False

    Set regexFullDate = CreateObject("VBScript.RegExp")
    regexFullDate.pattern = "^\d{1,2}/\d{1,2}/\d{4}$" ' Date complète : DD/MM/YYYY
    regexFullDate.Global = False

    ' Vérifier les formats de date

    ' Année seulement : YYYY
    If regexYear.Test(dateStr) Then
        CheckDate = CInt(dateStr)
        Exit Function
    End If

    If Not yearOnly Then
        ' Mois/Année : MM/YYYY
        If regexMonthYear.Test(dateStr) Then
            yearStr = Right(dateStr, 4)
            CheckDate = CInt(yearStr)
            Exit Function
        End If

        ' Date complète : DD/MM/YYYY
        If regexFullDate.Test(dateStr) Then
            yearStr = Right(dateStr, 4)
            CheckDate = CInt(yearStr)
            Exit Function
        End If
    End If

    ' Aucun motif ne correspond
    CheckDate = CVErr(xlErrValue) ' Retourne une erreur
End Function

' Fonction pour supprimer les préfixes et suffixes
Function RemovePrefixesAndSuffixes(ByVal dateStr As String) As String
    Dim prefixesSuffixes As Variant
    prefixesSuffixes = Array("ca.", "ca", "av.", "av")
    Dim prefixSuffix As Variant
    Dim pattern As String
    Dim regex As Object

    ' Supprimer les préfixes
    For Each prefixSuffix In prefixesSuffixes
        pattern = "^\s*" & prefixSuffix & "\.?\s+"
        Set regex = CreateObject("VBScript.RegExp")
        regex.pattern = pattern
        regex.IgnoreCase = True
        regex.Global = False
        dateStr = regex.Replace(dateStr, "")
    Next prefixSuffix

    ' Supprimer les suffixes
    For Each prefixSuffix In prefixesSuffixes
        pattern = "\s+" & prefixSuffix & "\.?\s*$"
        Set regex = CreateObject("VBScript.RegExp")
        regex.pattern = pattern
        regex.IgnoreCase = True
        regex.Global = False
        dateStr = regex.Replace(dateStr, "")
    Next prefixSuffix

    RemovePrefixesAndSuffixes = Trim(dateStr)
End Function

' Fonction pour normaliser les espaces
Function NormalizeSpaces(ByVal s As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.pattern = "\s+"
    regex.Global = True
    NormalizeSpaces = regex.Replace(s, " ")
End Function


Function CheckPeriod(period As String) As Variant
    Dim regexYearRange As Object, regexYearInterval As Object, regexSingleYear As Object
    Dim startYear As Integer, endYear As Integer
    Dim result(1 To 2) As Integer ' Array to hold start and end years if matched

    ' Initialize regex for year range (e.g., "yyyy-yyyy")
    Set regexYearRange = CreateObject("VBScript.RegExp")
    With regexYearRange
        .pattern = "^\d{4}-\d{4}$" ' Matches a range like "yyyy-yyyy"
        .Global = False
    End With
    
    ' Initialize regex for year interval (e.g., "yyyy ; yyyy")
    Set regexYearInterval = CreateObject("VBScript.RegExp")
    With regexYearInterval
        .pattern = "^\d{4} ; \d{4}$" ' Matches an interval like "yyyy ; yyyy"
        .Global = False
    End With

    ' Initialize regex for single year (e.g., "yyyy")
    Set regexSingleYear = CreateObject("VBScript.RegExp")
    With regexSingleYear
        .pattern = "^\d{4}$" ' Matches a single year like "yyyy"
        .Global = False
    End With

    ' Check for year range pattern
    If regexYearRange.Test(period) Then
        ' Extract the start and end years
        startYear = CInt(Left(period, 4))
        endYear = CInt(Right(period, 4))
        
        ' Store in result array
        result(1) = startYear
        result(2) = endYear
        CheckPeriod = result ' Return the array with start and end years

    ' Check for year interval pattern
    ElseIf regexYearInterval.Test(period) Then
        ' Extract the start and end years
        startYear = CInt(Left(period, 4))
        endYear = CInt(Right(period, 4))
        
        ' Store in result array
        result(1) = startYear
        result(2) = endYear
        CheckPeriod = result ' Return the array with start and end years

    ' Check for single year pattern
    ElseIf regexSingleYear.Test(period) Then
        ' Single year, so both start and end are the same
        startYear = CInt(period)
        endYear = startYear
        
        ' Store in result array
        result(1) = startYear
        result(2) = endYear
        CheckPeriod = result ' Return the array with start and end years

    ' No matching pattern
    Else
        CheckPeriod = CVErr(xlErrValue) ' Return an error to indicate no match
    End If
End Function


Sub ValidateYearFormat(ByVal ws As Worksheet, ByVal yearColumn As String)
    Dim lastRow As Long
    Dim yearValue As String
    Dim i As Long
    Dim colNumber As Long
    Dim result As Variant
    
    ' Initialize error report for year format issues
    yearFormatErrors = ""
    
    ' Find the column number for the specified year column
    colNumber = GetColumnNumbers(ws, yearColumn)
    If colNumber = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & yearColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Find the last row with data
    lastRow = ws.Cells(ws.Rows.Count, colNumber).End(xlUp).Row
    
    ' Loop to validate each year in the column
    For i = 2 To lastRow
        yearValue = ws.Cells(i, colNumber).value
        
        ' Check if the cell is empty or contains "nan"
        If yearValue = "" Or yearValue = "nan" Then
            ' Ignore empty values
            GoTo NextRow
        End If

        result = CheckDate(yearValue, True, True)

        If IsError(result) Then
            ' Log the error for invalid year format
            yearFormatErrors = yearFormatErrors & "Erreur : L'année '" & yearValue & "' à la ligne " & i & " dans la colonne '" & yearColumn & "' de la feuille '" & ws.name & "' n'est pas au format AAAA." & vbCrLf
            ' Highlight the cell in red
            ws.Cells(i, colNumber).Interior.Color = RGB(255, 0, 0)
        End If
NextRow:
    Next i
    
End Sub

Sub ValidatePeriodColumn(ByVal ws As Worksheet, ByVal periodColumn As String)
    Dim lastRow As Long
    Dim i As Long
    Dim periodValue As String
    Dim dates As Variant
    Dim periodColNum As Long
    Dim result As Variant
    
    ' Initialize the error variable
    periodValidationErrors = ""
    
    ' Get the column number for the period column
    periodColNum = GetColumnNumbers(ws, periodColumn)
    If periodColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & periodColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Find the last row with data
    lastRow = ws.Cells(ws.Rows.Count, periodColNum).End(xlUp).Row
    
    ' Loop through each row to validate the period
    For i = 2 To lastRow
        periodValue = ws.Cells(i, periodColNum).value
        
        ' Ignore empty values
        If periodValue = "" Then GoTo NextRow
        
        result = CheckPeriod(periodValue)

        ' Check if the period is either a single year or a valid year range
        If IsError(result) Then
            periodValidationErrors = periodValidationErrors & "Erreur : La valeur '" & periodValue & "' à la ligne " & i & " dans la colonne '" & periodColumn & "' n'est pas au format 'AAAA' ou 'AAAA-AAAA'." & vbCrLf
            ws.Cells(i, periodColNum).Interior.Color = RGB(255, 0, 0) ' Highlight the cell in red
            GoTo NextRow
        End If
        
        ' If it's a year range (AAAA-AAAA), validate the range
        ' Check if the start year is greater than the end year
        If result(1) > result(2) Then
            periodValidationErrors = periodValidationErrors & "Erreur : Dans la période '" & periodValue & "' à la ligne " & i & ", l'année de début est après l'année de fin." & vbCrLf
            ws.Cells(i, periodColNum).Interior.Color = RGB(255, 0, 0) ' Highlight the cell in red
        End If

NextRow:
    Next i
    
End Sub





Sub ValidateReversePersonRelationships(ByVal ws As Worksheet, ByVal idColumn As String, ByVal relationColumn As String)
    Dim lastRow As Long, i As Long, j As Long
    Dim personID As String, relatedPersonIDs As String, relatedPersonID As String
    Dim reverseFound As Boolean
    Dim relatedPersons As Variant
    Dim relatedPersonRow As Long
    Dim relatedPersonRelationValue As String
    Dim idDict As Object
    Set idDict = CreateObject("Scripting.Dictionary")
    
    ' Find the last row with data
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' Get column numbers for ID and Relation columns
    Dim idColNum As Long, relationColNum As Long
    idColNum = GetColumnNumbers(ws, idColumn)
    relationColNum = GetColumnNumbers(ws, relationColumn)
    
    ' Check if the columns exist
    If idColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & idColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    If relationColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & relationColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Load all person IDs into a dictionary
    For i = 2 To lastRow
        personID = Trim(CStr(ws.Cells(i, idColNum).value))
        If personID <> "" Then
            If Not idDict.Exists(personID) Then
                idDict.Add personID, i
            End If
        End If
    Next i
    
    ' Loop through each row to validate reverse relationships
    For i = 2 To lastRow
        personID = Trim(CStr(ws.Cells(i, idColNum).value))
        If personID = "" Then GoTo NextPerson
        
        relatedPersonIDs = Trim(CStr(ws.Cells(i, relationColNum).value))
        If relatedPersonIDs <> "" Then
            relatedPersonIDs = Replace(relatedPersonIDs, ",", ";")
            relatedPersons = Split(relatedPersonIDs, ";")
            
            ' Loop through each related person ID
            For j = LBound(relatedPersons) To UBound(relatedPersons)
                relatedPersonID = Trim(CStr(relatedPersons(j)))
                If relatedPersonID <> "" Then
                    If idDict.Exists(relatedPersonID) Then
                        reverseFound = False
                        relatedPersonRow = idDict(relatedPersonID)
                        relatedPersonRelationValue = Trim(CStr(ws.Cells(relatedPersonRow, relationColNum).value))
                        
                        If relatedPersonRelationValue <> "" Then
                            relatedPersonRelationValue = Replace(relatedPersonRelationValue, ",", ";")
                            Dim relatedPersonRelations As Variant
                            relatedPersonRelations = Split(relatedPersonRelationValue, ";")
                            Dim k As Long
                            
                            ' Check if personID is in the relations of relatedPersonID
                            For k = LBound(relatedPersonRelations) To UBound(relatedPersonRelations)
                                If Trim(relatedPersonRelations(k)) = personID Then
                                    reverseFound = True
                                    Exit For
                                End If
                            Next k
                        End If
                        
                        ' If the reverse relationship is not found, add an error
                        If Not reverseFound Then
                            reverseErrors = reverseErrors & "Erreur : La personne '" & personID & "' (ligne " & i & ") est liée à '" & relatedPersonID & "', mais la relation inverse est manquante à la ligne " & relatedPersonRow & "." & vbCrLf
                            
                            ' Highlight only the missing identifier in red
                            Dim startPos As Integer
                            startPos = InStr(ws.Cells(i, relationColNum).value, relatedPersonID)
                            If startPos > 0 Then
                                With ws.Cells(i, relationColNum).Characters(Start:=startPos, Length:=Len(relatedPersonID)).Font
                                    .Color = RGB(255, 0, 0)
                                    .Bold = True
                                End With
                            End If
                        End If
                    Else
                        ' If the related person ID does not exist, add an error
                        reverseErrors = reverseErrors & "Erreur : La personne liée '" & relatedPersonID & "' à la ligne " & i & " n'existe pas dans la colonne '" & idColumn & "'." & vbCrLf
                        
                        ' Highlight only the missing identifier in red
                        startPos = InStr(ws.Cells(i, relationColNum).value, relatedPersonID)
                        If startPos > 0 Then
                            With ws.Cells(i, relationColNum).Characters(Start:=startPos, Length:=Len(relatedPersonID)).Font
                                .Color = RGB(255, 0, 0)
                                .Bold = True
                            End With
                        End If
                    End If
                End If
            Next j
        End If
NextPerson:
    Next i

End Sub

Sub ValidatePersonNames(ByVal wsData As Worksheet, ByVal wsPersonne As Worksheet, ByVal personColumn As String)
    Dim lastRow As Long, i As Long
    Dim cellValue As String, nom As String, prenom As String
    Dim personDict As Object
    Dim personColNum As Long
    Dim nomColNum As Long, prenomColNum As Long
    Dim formattedName As String
    Dim parts As Variant, individualNames As Variant
    Dim namePart As Variant
    Dim validFormat As Boolean

    ' Initialiser le dictionnaire pour stocker les noms de la feuille PERSONNE
    Set personDict = CreateObject("Scripting.Dictionary")
    
    ' Obtenir les numéros de colonne pour "Nom" et "Prénom" dans PERSONNE
    nomColNum = GetColumnNumbers(wsPersonne, "Nom")
    prenomColNum = GetColumnNumbers(wsPersonne, "Prénom")
    
    If nomColNum = -1 Or prenomColNum = -1 Then
        sortedReport = sortedReport & "Erreur : Les colonnes 'Nom' ou 'Prénom' sont manquantes dans la feuille PERSONNE." & vbCrLf
        Exit Sub
    End If
    
    ' Charger tous les noms complets (Nom + Prénom) de PERSONNE dans le dictionnaire
    For i = 2 To wsPersonne.Cells(wsPersonne.Rows.Count, nomColNum).End(xlUp).Row
        nom = Trim(wsPersonne.Cells(i, nomColNum).value)
        prenom = Trim(wsPersonne.Cells(i, prenomColNum).value)
        formattedName = LCase(nom & prenom) ' Concaténer Nom et Prénom sans espace ni virgule
        If Not personDict.Exists(formattedName) Then
            personDict.Add formattedName, i
        End If
    Next i
    
    ' Obtenir le numéro de colonne de la colonne à vérifier dans wsData
    personColNum = GetColumnNumbers(wsData, personColumn)
    If personColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & personColumn & "' est manquante dans la feuille " & wsData.name & "." & vbCrLf
        Exit Sub
    End If

    ' Valider les noms dans wsData
    For i = 2 To wsData.Cells(wsData.Rows.Count, personColNum).End(xlUp).Row
        cellValue = Trim(wsData.Cells(i, personColNum).value)
        
        If cellValue <> "" Then
            ' Séparer les noms multiples par le point-virgule
            individualNames = Split(cellValue, ";")
            validFormat = True
            
            ' Traiter chaque nom individuellement
            For Each namePart In individualNames
                namePart = Trim(namePart)
                
                ' Vérifier le format Nom, Prénom
                If InStr(namePart, ", ") = 0 Then
                    nameExistsErrors = nameExistsErrors & "Erreur de format : Le nom '" & namePart & "' à la ligne " & i & " dans la feuille " & wsData.name & " n'est pas au format 'Nom, Prénom'." & vbCrLf
                    wsData.Cells(i, personColNum).Interior.Color = RGB(255, 0, 0)
                    validFormat = False
                Else
                    ' Retirer la virgule et l'espace temporairement pour le matching
                    parts = Split(namePart, ", ")
                    nom = LCase(parts(0))
                    prenom = LCase(parts(1))
                    
                    formattedName = nom & prenom ' Concaténer Nom et Prénom sans espace ni virgule pour la recherche

                    ' Vérifier si le nom complet existe dans le dictionnaire
                    If Not personDict.Exists(formattedName) Then
                        nameExistsErrors = nameExistsErrors & "Erreur : Le nom '" & namePart & "' à la ligne " & i & " dans la feuille " & wsData.name & " n'existe pas dans la feuille PERSONNE." & vbCrLf
                        wsData.Cells(i, personColNum).Interior.Color = RGB(255, 0, 0)
                        validFormat = False
                    End If
                End If
            Next namePart
            
            ' Si tous les noms sont bien formatés et présents, laisser la cellule sans couleur
            If validFormat Then
                wsData.Cells(i, personColNum).Interior.ColorIndex = xlNone
            End If
        End If
    Next i
End Sub

Sub ValidateRestrictedValues(ByVal ws As Worksheet, ByVal columnName As String)
    Dim lastRow     As Long, i As Long
    Dim value       As String
    Dim columnIndex As Long
    Dim validationList As String
    Dim validValues As Variant
    Dim isListPresent As Boolean
    
    ' Predefined validation lists for specific columns
    Dim predefinedValues As Object
    Set predefinedValues = CreateObject("Scripting.Dictionary")
    
    ' Define predefined lists
    predefinedValues.Add "Genre", Array("Homme", "Femme")        ' Example: Validation for "Genre"
    predefinedValues.Add "Musicale O/N", Array("Oui", "Non")        ' Example: Validation for "Musicale O/N"
    predefinedValues.Add "Genre musical", Array("Motet", "Motet à grand choeur", "Motet à petit effectif", "Concerto", "Sonate", "Cantate italienne", "Cantate française", "Messe", "Air détaché", "Oratorio", "Oeuvre lyrique profane", "Autres", "Symphonie")
    predefinedValues.Add "Label = Dénomination (+ période)", Array("Académie de musique/Concert", "Opéra/Académie royale de musique", "Chapitre", "Instance municipale", "Instance religieuse", "Corporation", "Académie royale des Sciences", "Belles-lettres et Arts", "Intendance", "Concert des amateurs", "Parlement", "Instance judiciaire")
    predefinedValues.Add "Type", Array("Document administratif", "Traité", "Paroles de concert", "Texte normatif", "Affiche", "Article de périodique", "Monographie", "Partition", "Poésie", "réglements")
    predefinedValues.Add "Type" & Chr(10) & "(valeurs restreintes)", Array("Manuscrit", "Formulaire complété à la main", "Plan", "Dessin", "Partition")


    ' Find the column index using Match
    On Error Resume Next
    columnIndex = WorksheetFunction.match(columnName, ws.Rows(1), 0)
    On Error GoTo 0
    
    ' If the column is not found, log an error in the sortedReport
    If columnIndex = 0 Then
        sortedReport = sortedReport & "Erreur ValidateRestrictedValues : La colonne '" & columnName & "' n'a pas été trouvée dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Find the last row of data in the specified column
    lastRow = ws.Cells(ws.Rows.Count, columnIndex).End(xlUp).Row
    
    ' Ensure column name matching is cleaned up
    ' columnName = Trim(Replace(columnName, Chr(10), " "))        ' Remove line breaks and trim spaces
    
    
    ' Check if the column has a predefined list
    If predefinedValues.Exists(columnName) Then
        validValues = predefinedValues(columnName)
        isListPresent = True
    Else
        ' Check if the first data cell in the column has a dynamic validation list
        On Error Resume Next
        If ws.Cells(2, columnIndex).Validation.Type = xlValidateList Then
            validationList = ws.Cells(2, columnIndex).Validation.Formula1
            ' Remove the "=" at the start if the list refers to a named range
            If Left(validationList, 1) = "=" Then
                validationList = Mid(validationList, 2)
                validValues = ws.Parent.Names(validationList).RefersToRange.value
            Else
                validValues = Split(validationList, ",")
            End If
            isListPresent = True
        Else
            isListPresent = False
        End If
        On Error GoTo 0
    End If
    
    ' If no validation list is found, log an error and exit
    If Not isListPresent Then
        restrictedValueErrors = restrictedValueErrors & "Erreur ValidateRestrictedValue : aucune liste de validation trouvée pour la colonne '" & columnName & "' dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Loop through each row to check if the value is valid
    For i = 2 To lastRow
        value = Trim(CStr(ws.Cells(i, columnIndex).value))        ' Trim unnecessary spaces
        
        ' Check if the value exists in the validValues list
        If IsError(Application.match(value, validValues, 0)) Then
            ' If the value is not valid, add it to the restrictedValueErrors
            restrictedValueErrors = restrictedValueErrors & "La valeur '" & value & "' à la ligne " & i & " dans la colonne '" & columnName & "' de la feuille '" & ws.name & "' n'est pas une valeur valide." & vbCrLf
            ' Highlight the cell in red
            ws.Cells(i, columnIndex).Interior.Color = RGB(255, 0, 0)
        End If
    Next i
End Sub




Sub ValidateNumericValues(ByVal ws As Worksheet, ByVal columnName As String)
    Dim lastRow     As Long, i As Long
    Dim value       As Variant
    Dim colNum      As Long
    
    ' Get the column number
    colNum = GetColumnNumbers(ws, columnName)
    
    ' Loop through the rows to check numeric values
    lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row
    For i = 2 To lastRow
        value = ws.Cells(i, colNum).value
        
        ' Check if the value is numeric
        If Not IsNumeric(value) And Not IsEmpty(value) Then
            ' Highlight the error in red
            ws.Cells(i, colNum).Interior.Color = RGB(255, 0, 0)
            ' Add error message to the numericErrors variable
            numericErrors = numericErrors & "Erreur : La valeur '" & value & "' à la ligne " & i & " dans la colonne '" & columnName & "' de la feuille '" & ws.name & "' n'est pas numérique." & vbCrLf
        End If
    Next i

End Sub

Sub ValidateIdentifiers(ByVal wsData As Worksheet, ByVal optionalColumn As String, ByVal wsSource As Worksheet, ByVal sourceIDColumn As String, ByVal expectedPrefix As String)
    Dim lastRowData As Long, lastRowSource As Long
    Dim idValue As String, idArray As Variant, singleID As String
    Dim dataColNum As Long, sourceColNum As Long
    Dim sourceDict As Object
    Dim i As Long, j As Long
    
    ' Get the column numbers for the optional column in wsData and the source column in wsSource
    dataColNum = GetColumnNumbers(wsData, optionalColumn)
    sourceColNum = GetColumnNumbers(wsSource, sourceIDColumn)
    
    ' Check if the columns exist
    If dataColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & optionalColumn & "' n'existe pas dans la feuille '" & wsData.name & "'." & vbCrLf
        Exit Sub
    End If
    If sourceColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne '" & sourceIDColumn & "' n'existe pas dans la feuille source '" & wsSource.name & "'." & vbCrLf
        Exit Sub
    End If

    ' Initialize the dictionary to store IDs from the source column
    Set sourceDict = CreateObject("Scripting.Dictionary")

    ' Load all IDs from the source column in wsSource into the dictionary
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, sourceColNum).End(xlUp).Row
    For i = 2 To lastRowSource
        idValue = Trim(CStr(wsSource.Cells(i, sourceColNum).value))
        If idValue <> "" Then
            If Not sourceDict.Exists(idValue) Then
                sourceDict.Add idValue, i
            End If
        End If
    Next i

    ' Get the last row with data in the optional column
    lastRowData = wsData.Cells(wsData.Rows.Count, dataColNum).End(xlUp).Row
    
    ' Loop through each row in the optional column to check for prefix and format errors
    For i = 2 To lastRowData
        idValue = CleanString(CStr(wsData.Cells(i, dataColNum).value))
        
        If idValue <> "" Then
            idArray = Split(idValue, ";")
            
            For j = LBound(idArray) To UBound(idArray)
                singleID = CleanString(CStr(idArray(j)))
                
                If singleID <> "" Then
                    ' Check if ID has the correct prefix format
                    If StrComp(Left(singleID, Len(expectedPrefix)), expectedPrefix, vbTextCompare) <> 0 Then
                        ' Check if it follows the expected structural format for valid prefixes
                        If Not IsValidPrefix(singleID) Then
                            ' Add to format errors if it doesn't match the required structure
                            prefixErrors = prefixErrors & "Erreur de préfixe : L'ID '" & singleID & "' à la ligne " & i & " dans la colonne '" & optionalColumn & "' de la feuille '" & wsData.name & "' ne commence pas par le préfixe attendu '" & expectedPrefix & "'." & vbCrLf
                            wsData.Cells(i, dataColNum).Interior.Color = RGB(255, 255, 0)  ' Highlight for format error
                        Else
                            ' Add to prefix errors if it has a valid prefix but it's misplaced
                            formatErrors = formatErrors & "Erreur de format d'identifiant : L'ID '" & singleID & "' à la ligne " & i & " dans la colonne '" & optionalColumn & "' de la feuille '" & wsData.name & "' ne respecte pas le format attendu." & vbCrLf
                            wsData.Cells(i, dataColNum).Interior.Color = RGB(255, 200, 200)  ' Highlight for prefix error
                        End If
                    ElseIf Not sourceDict.Exists(singleID) Then
                        ' If the ID has the correct prefix but doesn't exist in the source, add to missing ID errors
                        missingIDErrors = missingIDErrors & "Erreur d'ID manquant : L'ID '" & singleID & "' à la ligne " & i & " dans la colonne '" & optionalColumn & "' de la feuille '" & wsData.name & "' n'existe pas dans la colonne '" & sourceIDColumn & "' de la feuille source." & vbCrLf
                        wsData.Cells(i, dataColNum).Interior.Color = RGB(255, 0, 0)  ' Highlight for missing ID error
                    End If
                End If
            Next j
        End If
    Next i
    
End Sub

Function IsValidPrefix(idValue As String) As Boolean
    ' This function checks if the ID follows the general prefix format "prefix + initials + number"
    Dim pattern As String
    pattern = "^[a-zA-Z]+[A-Za-z]{3}\d+$"  ' Example pattern, adjust as needed
    IsValidPrefix = (idValue Like pattern)
End Function





Function CleanMultipleIDs(ByVal wsData As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal columnName As String) As String
    Dim idArray     As Variant
    Dim cleanedID   As String
    Dim i           As Long
    Dim hasExtraSpaces As Boolean
    Dim originalStr As String
    
    ' Store the original string to compare later
    originalStr = wsData.Cells(rowNum, colNum).value
    
    ' Split the string by semicolons
    idArray = Split(originalStr, ";")
    
    ' Loop through each ID and clean it
    For i = LBound(idArray) To UBound(idArray)
        ' Trim spaces around each ID
        idArray(i) = Trim(CleanString(CStr(idArray(i))))
        
        ' Append cleaned ID back to the result
        If cleanedID <> "" Then
            cleanedID = cleanedID & " ; " & idArray(i)        ' Ensure proper formatting
        Else
            cleanedID = idArray(i)
        End If
    Next i
    
    ' Check if the cleaned ID differs from the original string (indicating extra spaces)
    If cleanedID <> originalStr Then
        hasExtraSpaces = True
        ' Highlight the cell in red to indicate extra spaces
        wsData.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        
        ' Add an error to the sorted report indicating extra spaces were found
        multipleIDFormatErrors = multipleIDFormatErrors & "Erreur : Des espaces supplémentaires ont été détectés dans '" & columnName & "' à la ligne " & rowNum & " de la feuille '" & wsData.name & "'." & vbCrLf
    End If
    
    ' Return the cleaned string of IDs
    CleanMultipleIDs = cleanedID
    
End Function

Sub CleanAndValidate(ByVal wsData As Worksheet, ByVal optionalColumn As String, ByVal wsSource As Worksheet, ByVal sourceIDColumn As String, ByVal expectedPrefix As String)
    Dim dataColNum  As Long
    Dim i           As Long
    Dim lastRow     As Long
    
    ' Get the column number for the optional column
    dataColNum = GetColumnNumbers(wsData, optionalColumn)
    
    ' Add error handling in case of unexpected issues
    ' On Error GoTo ErrorHandler
    
    ' Find the last row in the data sheet for the column
    lastRow = wsData.Cells(wsData.Rows.Count, dataColNum).End(xlUp).Row
    
    ' Clean the multiple IDs in the column for each row and validate
    For i = 2 To lastRow
        wsData.Cells(i, dataColNum).value = CleanMultipleIDs(wsData, i, dataColNum, optionalColumn)
    Next i
    
    ' After cleaning, validate the IDs for the expected prefix and existence in the source sheet
    Call ValidateIdentifiers(wsData, optionalColumn, wsSource, sourceIDColumn, expectedPrefix)
    
    Exit Sub
    
ErrorHandler:
    ' sortedReport = sortedReport & "Erreur dans la feuille '" & wsData.Name & "' pour la colonne '" & optionalColumn & "'." & vbCrLf
    ' Resume Next
End Sub

' Fonction pour trier un tableau de nombres (ordre croissant)
Function SortArray(arr() As Long) As Long()
    Dim i           As Long, j As Long, temp As Long
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    SortArray = arr
End Function

Sub ValidateUniqueIDs(ByVal ws As Worksheet, ByVal idColumn As String, ByVal prefix)
    Dim lastRow     As Long, i As Long
    Dim idDict      As Object
    Dim idColNum    As Long
    Dim rowNumbers  As String
    Dim originalIDValue As String
    Dim trimmedIDValue As String
    
    ' Initialiser le dictionnaire pour stocker les IDs
    Set idDict = CreateObject("Scripting.Dictionary")
    
    ' Obtenir le numéro de colonne pour la colonne ID
    idColNum = GetColumnNumbers(ws, idColumn)
    If idColNum = -1 Then
        sortedReport = sortedReport & "Erreur ValidateUniqueIDs : La colonne '" & idColumn & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Trouver la dernière ligne de données dans la colonne ID
    lastRow = ws.Cells(ws.Rows.Count, idColNum).End(xlUp).Row
    
    ' Boucler à travers chaque ligne pour vérifier les IDs dupliqués
    For i = 2 To lastRow
    
        ' Get the original value from the cell
        originalIDValue = CStr(ws.Cells(i, idColNum).value)

        ' Trim the value
        trimmedIDValue = CleanString(originalIDValue)

        ' Skip empty or invalid values
        If trimmedIDValue = "" Or LCase(trimmedIDValue) = "nan" Then GoTo NextRow

        ' Check if the trimmed value is different from the original
        If trimmedIDValue <> originalIDValue Then
            ' Put the trimmed value back into the cell
            ws.Cells(i, idColNum).value = trimmedIDValue
            ' Set the cell's background color to red
            ws.Cells(i, idColNum).Interior.Color = RGB(255, 0, 0)
        End If
      
        ' Check if the ID has the right prefix
        ' Ensure trimmedValue is at least as long as prefix
        ' Check if the prefix matches (case-insensitive)
        If Len(trimmedIDValue) < Len(prefix) Or StrComp(Left(trimmedIDValue, Len(prefix)), prefix, vbTextCompare) <> 0 Then
            ' Highlight the cell in red
            ws.Cells(i, idColNum).Interior.Color = RGB(255, 0, 0)
            ' Optionally, collect error information
            prefixErrors = prefixErrors & "Erreur de préfixe : 'ID '" & trimmedIDValue & "' à la ligne " & i & " ne commence pas par le préfixe attendu '" & prefix & "'." & vbCrLf
        End If
        
        ' Check if the ID already exists in the dictionary
        If idDict.Exists(trimmedIDValue) Then
            ' Si dupliqué, rapporter les numéros de ligne
            rowNumbers = idDict(trimmedIDValue) & " et " & i
            duplicateIdErrors = duplicateIdErrors & "L'ID '" & trimmedIDValue & "' à la ligne " & rowNumbers & " dans la colonne '" & idColumn & "' de la feuille '" & ws.name & "' est dupliqué." & vbCrLf
            ws.Cells(i, idColNum).Interior.Color = RGB(255, 0, 0)        ' Colorer la cellule en rouge
            ws.Cells(idDict(trimmedIDValue), idColNum).Interior.Color = RGB(255, 0, 0)        ' Colorer également la première occurrence
        Else
            ' Si non dupliqué, l'ajouter au dictionnaire avec son numéro de ligne
            idDict.Add trimmedIDValue, i
        End If
        
NextRow:
    Next i

End Sub

Sub CleanSheet(ByVal ws As Worksheet)

    Dim rng As Range
    Set rng = ws.UsedRange ' Targets all used cells in the worksheet

    Dim arr As Variant
    arr = rng.value ' Reads the range values into an array for faster processing

    Dim i As Long, j As Long
    Dim cellValue As Variant

    ' Optimize performance
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ' Loop through the array and clean each cell
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            cellValue = arr(i, j)
            If Not IsError(cellValue) Then
                If VarType(cellValue) = vbString Then
                    arr(i, j) = ReplaceMultipleSpaces(Trim(cellValue))
                End If
            End If
        Next j
    Next i

    rng.value = arr ' Writes the cleaned data back to the worksheet

    ' Restore application settings
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Function ReplaceMultipleSpaces(ByVal text As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    ' Replace only multiple occurrences of space, but not cr-lf!
    With regex
        .pattern = "[ \t]+"
        .Global = True
    End With
    ReplaceMultipleSpaces = regex.Replace(text, " ")
End Function

Sub CleanSpaces(ByVal wsData As Worksheet)
    Dim lastRow     As Long
    Dim lastCol     As Long
    Dim i           As Long, j As Long
    Dim cellValue   As Variant
    Dim colName     As String
    Dim hasLeadingSpaces As Boolean
    Dim hasTrailingSpaces As Boolean
    Dim hasDoubleSpaces As Boolean
    Dim cellAddress As String
    
    ' Désactive la mise à jour de l'écran et le calcul automatique pour améliorer les performances
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Trouve la dernière ligne et la dernière colonne avec des données
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    
    ' Parcourt toutes les colonnes
    For j = 1 To lastCol
        ' Obtient le nom de la colonne (en-tête)
        colName = wsData.Cells(1, j).value
        
        ' Parcourt toutes les lignes à partir de la deuxième
        For i = 2 To lastRow
            cellValue = wsData.Cells(i, j).value
            hasLeadingSpaces = False
            hasTrailingSpaces = False
            hasDoubleSpaces = False
            
            ' Vérifie si cellValue est une chaîne non vide
            If VarType(cellValue) = vbString And Trim(cellValue) <> "" Then
                ' Vérifie les espaces avant le premier caractère
                If Left(cellValue, 1) = " " Then
                    hasLeadingSpaces = True
                End If
                
                ' Vérifie les espaces après le dernier caractère
                If Right(cellValue, 1) = " " Then
                    hasTrailingSpaces = True
                End If
                
                ' Vérifie les doubles espaces dans la chaîne
                If InStr(1, cellValue, "  ") > 0 Then
                    hasDoubleSpaces = True
                End If
                
                ' Si des problèmes d'espaces sont détectés, met en surbrillance la cellule et ajoute des messages d'erreur
                If hasLeadingSpaces Or hasTrailingSpaces Or hasDoubleSpaces Then
                    wsData.Cells(i, j).Interior.Color = RGB(255, 0, 0)        ' Met en surbrillance en rouge
                    cellAddress = wsData.Cells(i, j).Address(False, False)
                    
                    ' Ajoute des messages d'erreur spécifiques
                    If hasLeadingSpaces Then
                        spaceErrors = spaceErrors & "Erreur d'espaces : Un espace avant le premier caractère dans la cellule " & cellAddress & " de la colonne '" & colName & "'." & vbNewLine
                    End If
                    If hasTrailingSpaces Then
                        spaceErrors = spaceErrors & "Erreur d'espaces : Un espace après le dernier caractère dans la cellule " & cellAddress & " de la colonne '" & colName & "'." & vbNewLine
                    End If
                    If hasDoubleSpaces Then
                        spaceErrors = spaceErrors & "Erreur d'espaces : Des espaces multiples détectés dans la cellule " & cellAddress & " de la colonne '" & colName & "'." & vbNewLine
                    End If
                End If
            End If
        Next i
    Next j
    
    ' Rétablit la mise à jour de l'écran et le calcul automatique
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub CheckHyphensInPrenom(ByVal ws As Worksheet)
    Dim lastRow     As Long, i As Long
    Dim prenomColNum As Long
    Dim cellValue   As String

    
    hyphensErrors = ""
    
    ' Get the column number for "Prénom"
    prenomColNum = GetColumnNumbers(ws, "Prénom")
    
    ' If the column doesn't exist, log an error
    If prenomColNum = -1 Then
        sortedReport = sortedReport & "Erreur : La colonne 'Prénom' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Find the last row of data
    lastRow = ws.Cells(ws.Rows.Count, prenomColNum).End(xlUp).Row
    
    ' Loop through each row and check for hyphens in "Prénom" column
    For i = 2 To lastRow
        cellValue = Trim(CStr(ws.Cells(i, prenomColNum).value))
        
        ' Check if the name contains a hyphen and is not "Jean-Baptiste"
        If InStr(cellValue, "-") > 0 And LCase(cellValue) <> "jean-baptiste" Then
            ' Highlight the error in red and add it to the hyphenErrors category
            ws.Cells(i, prenomColNum).Interior.Color = RGB(255, 0, 0)
            hyphensErrors = hyphensErrors & "Erreur : Le prénom '" & cellValue & "' à la ligne " & i & " dans la feuille '" & ws.name & "' contient un trait d'union non autorisé." & vbCrLf
        End If
    Next i
    
End Sub

Sub SaveHighlightedCopy(wbData As Workbook)
    Dim newFilePath As String
    
    ' Ask the user where they want to save the copy
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Sauvegardez une copie du fichier de données avec les cellules surlignées"
        .InitialFileName = wbData.Path & "\" & Replace(wbData.name, ".xlsx", "_copie_avec_erreurs.xlsx")
        If .Show = -1 Then
            newFilePath = .SelectedItems(1)
        Else
            MsgBox "Opération annulée."
            Exit Sub
        End If
    End With
    
    ' Save the copy of the workbook with a new name
    wbData.SaveCopyAs newFilePath
    
    MsgBox "La copie du fichier avec les erreurs surlignées a été sauvegardée : " & newFilePath, vbInformation
End Sub


Sub PopulateProperNamesDictionary(ByRef wsPersonne As Worksheet)

    Dim lastRow As Long, i As Long
    Dim nom As String, prenom As String, fullName As String
    Dim nomCol As Integer, prenomCol As Integer
    
    ' Find the last row in the PERSONNE sheet
    lastRow = wsPersonne.Cells(wsPersonne.Rows.Count, 1).End(xlUp).Row
    
    ' Get column numbers for "Nom" and "Prénom"
    nomCol = GetColumnNumbers(wsPersonne, "Nom")
    If nomCol = -1 Then
        sortedReport = sortedReport & "Erreur PopulateProperNamesDictionary : La colonne 'Nom' n'existe pas dans la feuille '" & wsPersonne.name & "'." & vbCrLf
        Exit Sub
    End If
    
    prenomCol = GetColumnNumbers(wsPersonne, "Prénom")
    If prenomCol = -1 Then
        sortedReport = sortedReport & "Erreur PopulateProperNamesDictionary : La colonne 'Prénom' n'existe pas dans la feuille '" & wsPersonne.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Loop through each row and add "Nom" and "Prénom" combinations to the dictionary
    For i = 2 To lastRow
        nom = Trim(wsPersonne.Cells(i, nomCol).value)
        prenom = Trim(wsPersonne.Cells(i, prenomCol).value)
        
        ' Process and add individual names to the dictionary
        If nom <> "" Then
            ' Debug.Print "Nom " & nom
            Call AddWordsToDictionary(properNamesDict, nom)
        End If
        If prenom <> "" Then
            ' Debug.Print "Prénom " & prenom
            Call AddWordsToDictionary(properNamesDict, prenom)
        End If
        ' Add full name if both nom and prenom are present
        ' If nom <> "" And prenom <> "" Then
        '     fullName = Trim(nom & " " & prenom)
        '     properNamesDict(LCase(fullName)) = True
        ' End If
    Next i
       
    ' Debug print the dictionary contents
    ' Debug.Print "Contents of Proper Names Dictionary:"
    ' Dim key As Variant
    ' For Each key In properNamesDict.Keys
        ' Debug.Print key
    ' Next key
    
End Sub

' Helper function to split names and add each part to the dictionary
Sub AddWordsToDictionary(ByRef dict As Object, ByVal text As String)
    Dim words() As String
    Dim word As Variant
    
    ' Remove extra whitespace and split by ";" first
    If text <> "" Then
        words = Split(text, ";")
        For Each word In words
            word = Trim(word) ' Remove extra spaces
            
            ' Further split by spaces if the word contains multiple parts
            Dim subWords() As String
            Dim subWord As Variant
            subWords = Split(word, " ")
            For Each subWord In subWords
                subWord = LCase(Trim(subWord))
                If subWord <> "" Then
                    ' Add each cleaned word to the dictionary
                    If Not properNamesDict.Exists(subWord) Then
                        properNamesDict.Add subWord, True
                        ' Debug.Print "Adding " & subWord
                    End If
                End If
            Next subWord
        Next word
    End If
End Sub


Sub ValidateSpelling(ws As Worksheet, columnName As String)
    Dim lastRow As Long, i As Long
    Dim colNum As Long
    Dim cellValue As String
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim wordRange As Object

    ' Initialize Word Application and Document
    On Error Resume Next
    Set wordApp = CreateObject("Word.Application")
    On Error GoTo 0
    
    If wordApp Is Nothing Then
        MsgBox "Microsoft Word is not available. Please ensure it is installed.", vbCritical
        Exit Sub
    End If

    wordApp.Visible = False ' Keep Word hidden
    Set wordDoc = wordApp.Documents.Add
    wordDoc.Content.LanguageID = 1036 ' Set to French
    
    ' Get the column number for the specified column
    colNum = GetColumnNumbers(ws, columnName)
    If colNum = -1 Then
        ' MsgBox "Error: Column '" & columnName & "' not found in sheet '" & ws.name & "'.", vbCritical
        sortedReport = sortedReport & "Erreur ValidateSpelling : La colonne '" & columnName & "' n'existe pas dans la feuille '" & ws.name & "'." & vbCrLf
        Exit Sub
    End If
    
    ' Find the last row in the sheet
    lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row
    
    ' Loop through each cell in the column and check spelling
    For i = 2 To lastRow
        ' CleanString destroys non printable chars, which is bad for spelling
        ' cellValue = CleanString(ws.Cells(i, colNum).value)
        cellValue = ws.Cells(i, colNum).value
 
        ' cellValue = CleanReplaceNonPrintable(ws.Cells(i, colNum).value)
        cellValue = CleanReplaceNonPrintable(cellValue)
        cellValue = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(cellValue, ".", " "), ",", " "), ";", " "), ":", " "), "(", " "), ")", " "), "[", " "), "]", " ")  ' Additional punctuation cleaning
        cellValue = Trim(ReplaceMultipleSpaces(cellValue))
        If Not IsEmpty(cellValue) Then
            ' Check each word only if not in the proper names dictionary
            Dim checkText As String
            checkText = ""
            
            Dim word As Variant
            Dim wordArray() As String
            wordArray = Split(cellValue, " ")
            
            For Each word In wordArray
                If word <> "" And Not properNamesDict.Exists(LCase(word)) Then
                    checkText = checkText & word & " "
                End If
            Next word
            
            If Len(checkText) > 0 Then
                ' Check spelling of filtered content
                wordDoc.Content.text = checkText
                If wordDoc.SpellingErrors.Count > 0 Then
                    For Each wordRange In wordDoc.SpellingErrors
                        ' Add to error report
                        misspelledErrors = misspelledErrors & "Feuille '" & ws.name & "', Colonne '" & columnName & "', Ligne " & i & ": '" & wordRange.text & "' est mal orthographié." & vbCrLf
                        ' Highlight in Excel
                        ws.Cells(i, colNum).Interior.Color = RGB(255, 0, 0)
                    Next wordRange
                End If
            End If
        End If
    Next i
    
    ' Close Word
    wordDoc.Close False
    Set wordDoc = Nothing
    wordApp.Quit
    Set wordApp = Nothing

End Sub

Sub CheckIdentifiersInComments(ws As Worksheet, columnName As String)
    Dim lastRow As Long, i As Long
    Dim identifierDict As Object
    Dim colNumID As Long
    Dim colNumComments As Long
    Dim cellValue As String
    Dim regex As Object
    Dim matches As Object
    Dim match As Object
    
    ' Initialize dictionary to store all unique identifiers across sheets
    Set identifierDict = CreateObject("Scripting.Dictionary")
    
    ' Initialize regular expression object
    Set regex = CreateObject("VBScript.RegExp")
    ' Set up regex pattern to match any word-like strings (alphanumeric and underscores)
    With regex
        .IgnoreCase = True
        .Global = True
        .pattern = "\b(arch|work|place|print|person|event|group|repo)[A-Za-z]{3}\d+\b"
    End With
                
    ' Pas besoin : ces identifiants sont suffisamment spécifiques
    ' D'autre part, il est possible que l'utilisateur commette une typo
    ' ou bien n'ait pas fini de remplir la feuille et l'identifiant
    ' n'existera pas. Plus simple de détecter tous ceux qui ont cette forme.
    ' Populate the dictionary with IDs from all sheets
    ' Dim sheet As Worksheet
    ' For Each sheet In ThisWorkbook.Sheets
    '     colNumID = GetColumnNumbers(sheet, "ID")
        
    '     If colNumID <> -1 Then
    '         lastRow = sheet.Cells(sheet.Rows.Count, colNumID).End(xlUp).Row
    '         For i = 2 To lastRow
    '             If Not IsEmpty(sheet.Cells(i, colNumID).value) Then
    '                 ' Add identifier to the dictionary in lowercase
    '                 identifierDict(LCase(Trim(sheet.Cells(i, colNumID).value))) = True
    '             End If
    '         Next i
    '     End If
    ' Next sheet
    
    ' Check 'Commentaires publics' in the specified worksheet
    colNumComments = GetColumnNumbers(ws, columnName)
    
    If colNumComments <> -1 Then
        lastRow = ws.Cells(ws.Rows.Count, colNumComments).End(xlUp).Row
        
        For i = 2 To lastRow
            cellValue = ws.Cells(i, colNumComments).value
            
            If Not IsEmpty(cellValue) Then
                
                ' Find all words in the cell text
                Set matches = regex.Execute(cellValue)
                
                ' Loop through each match
                For Each match In matches
                    Dim word As String
                    word = match.value
                    
                    ' Check if the matched word is in the identifier dictionary
    '                 If identifierDict.Exists(word) Then
                        ' Add to error report
                        identifiantComment = identifiantComment & "Feuille '" & ws.name & "', Colonne '" & columnName & "', Ligne " & i & " : L'identifiant '" & word & "' doit être rentrer manuellement dans Omeka-S." & vbCrLf
                        ' Highlight cell in Excel
                        ws.Cells(i, colNumComments).Interior.Color = RGB(255, 0, 0)
    '                 End If
                Next match
            End If
        Next i
    End If
End Sub

