VERIFIE ET CORRIGE QU'IL N'Y A AUCUN CONFLIT ET AUCUNE ERREUR ET QUE TOUT EST CORRECTEMENT HARMONISÉ ET RÉORGANISE LE CODE AU BESOIN :

Option Explicit

' Variables du module
Dim CheminSource As String
Dim CheminDestination As String
Dim CheminJournal As String
Dim ClasseurSource As Workbook
Dim ClasseurDestination As Workbook
Dim ClasseurJournal As Workbook
Dim FeuilleSource As Worksheet
Dim FeuilleDestination As Worksheet
Dim FeuilleJournal As Worksheet

' Sous routines générales
Sub InitialisationDesVariables()
    ' Définition des chemins des fichiers
    CheminSource = "C:\Fonts\List_font_glyphs_1.xlsx"
    CheminDestination = "C:\Fonts\Reconstitution.xlsm"
    CheminJournal = "C:\Fonts\Log_Reconstitution.xlsm"

    ' Définition des classeurs
    Set ClasseurSource = Workbooks("List_font_glyphs_1.xlsx")
    Set ClasseurDestination = Workbooks("Reconstitution.xlsm")
    Set ClasseurJournal = Workbooks("Log_Reconstitution.xlsm")

    ' Définition des feuilles de calcul
    Set FeuilleSource = ClasseurSource.Sheets("Fonts 1")
    Set FeuilleDestination = ClasseurDestination.Sheets("Feuil1")
    Set FeuilleJournal = ClasseurJournal.Sheets("Feuil1")
End Sub

Sub ConfigurerApplication(Etat As Boolean)
    Application.ScreenUpdating = Etat
    If Etat Then
        Application.Calculation = xlCalculationAutomatic
    Else
        Application.Calculation = xlCalculationManual
    End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo 0
    Dim GaucheBouton As Long
    Dim HauteurBouton As Long
    Dim EspacementBouton As Long

    GaucheBouton = 10 ' Position horizontale initiale des boutons
    HauteurBouton = 20 ' Hauteur des boutons (modifiable selon vos besoins)
    EspacementBouton = 40 ' Espacement horizontal entre les boutons et la cellule sélectionnée

    With Target.Cells(1, 1)
        ' Vérification de la sélection entière de la colonne
        If Target.Address = ActiveSheet.UsedRange.Address Then
            ' Ajustement de la position des boutons en fonction de la colonne sélectionnée
            CommandButton1.Top = Target.Cells(1).Top
            CommandButton1.Left = CommandButton1.Left

            CommandButton2.Top = CommandButton1.Top + (3 * HauteurBouton) ' Décalage de deux fois la hauteur des boutons vers le bas
            CommandButton2.Left = CommandButton2.Left ' Même niveau horizontal que CommandButton1

            CommandButton3.Top = CommandButton2.Top + (3 * HauteurBouton) ' Décalage de trois fois la hauteur des boutons vers le bas
            CommandButton3.Left = CommandButton3.Left ' Même niveau horizontal que CommandButton1
            
        Else
            ' Ajustement de la position des boutons en fonction de la cellule active
            CommandButton1.Top = Target.Top
            CommandButton1.Left = Target.Left + Target.Width + EspacementBouton + GaucheBouton

            CommandButton2.Top = CommandButton1.Top + (3 * HauteurBouton)
            CommandButton2.Left = Target.Left + Target.Width + EspacementBouton + GaucheBouton

            CommandButton3.Top = CommandButton2.Top + (3 * HauteurBouton)
            CommandButton3.Left = Target.Left + Target.Width + EspacementBouton + GaucheBouton
            
        End If
    End With
    
    ' Vérification que la feuille entière n'est pas sélectionnée
    If Target.Address = ActiveSheet.UsedRange.Address Then
        Exit Sub ' Ignorer la sélection de toute la feuille
    End If
End Sub

' Fonctions générales
Function OuvrirClasseur(ByVal Chemin As String) As Workbook
    On Error Resume Next
    Set OuvrirClasseur = Workbooks(Chemin)
    On Error GoTo 0

    If OuvrirClasseur Is Nothing Then
        Set OuvrirClasseur = Workbooks.Open(Chemin)
    End If
End Function

Function ConvertirNumeroColonneEnLettre(NumColonne As Long) As String
    Dim LettreColonne As String
    LettreColonne = ""
    Do While NumColonne > 0
        LettreColonne = Chr(((NumColonne - 1) Mod 26) + 65) & LettreColonne
        NumColonne = (NumColonne - 1) \ 26
    Loop
    ConvertirNumeroColonneEnLettre = LettreColonne
End Function

' Sous routines spécifiques
Private Sub NettoyerFeuille(ByRef Feuille As Worksheet)
    Feuille.Cells.Clear
    Feuille.Cells.ClearFormats
    Feuille.Cells.ClearContents
    Feuille.Cells.ClearOutline
    Feuille.Cells.Select
    Selection.Delete Shift:=xlUp
    DoEvents
    Debug.Print "Nettoyage de la feuille : " & Feuille.Name
End Sub

Function ObtenirDernierePoliceTraitee(ByRef FeuilleJournal As Worksheet) As String
    Dim DerniereLigneJournal As Long
    DerniereLigneJournal = FeuilleJournal.Cells(FeuilleJournal.Rows.count, "A").End(xlUp).row
    
    If DerniereLigneJournal > 1 Then
        ObtenirDernierePoliceTraitee = FeuilleJournal.Cells(DerniereLigneJournal, 1).Value
    Else
        ObtenirDernierePoliceTraitee = ""
    End If
End Function

Function ObtenirColonneDepartPourTraitement(ByRef FeuilleSource As Worksheet, ByVal DernierePoliceTraitee As String) As Long
    Dim i As Long
    ObtenirColonneDepartPourTraitement = 1
    If DernierePoliceTraitee <> "" Then
        For i = 1 To FeuilleSource.Cells(1, Columns.count).End(xlToLeft).Column Step 2
            Debug.Print "Vérification de la colonne " & i & " : " & FeuilleSource.Cells(1, i).Value
            If FeuilleSource.Cells(1, i).Value = DernierePoliceTraitee Then
                ObtenirColonneDepartPourTraitement = i + 2
                Debug.Print "Police trouvée dans la colonne " & i & ". Nouvelle colonne de départ : " & ObtenirColonneDepartPourTraitement
                Exit For
            End If
        Next i
    Else
        Debug.Print "Aucune dernière police à traiter."
    End If
End Function

Function ColonneEnLettre(Colonne As Integer) As String
    If Colonne > 0 And Colonne <= Columns.count Then
        ColonneEnLettre = Split(Cells(1, Colonne).Address, "$")(1)
    Else
        ColonneEnLettre = "InvalidColumn"
    End If
End Function

Private Sub CopierDonnees(ByRef FeuilleSource As Worksheet, ByRef FeuilleDestination As Worksheet, ByVal ColonneDepart As Long)
    On Error GoTo ErrorHandler
    
    Dim i As Long
    For i = ColonneDepart To ColonneDepart + 1 'copier une colonne à la fois
        ' Copier la colonne
        FeuilleSource.Columns(i).Copy
        ' Coller la colonne dans la feuille de destination, dans la première colonne libre
        FeuilleDestination.Cells(1, i - ColonneDepart + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        ' Désactiver le mode de copie
        Application.CutCopyMode = False
    Next i
    
    Debug.Print "Données copiées avec succès."
    Exit Sub
    
ErrorHandler:
    Debug.Print "Erreur dans CopierDonnees(): " & Err.Description
End Sub

Private Sub EnregistrerPoliceDansJournal(ByRef FeuilleJournal As Worksheet, NomPolice As String)
    Dim DerniereLigneJournal As Long
    DerniereLigneJournal = FeuilleJournal.Cells(FeuilleJournal.Rows.count, "A").End(xlUp).row + 1
    FeuilleJournal.Cells(DerniereLigneJournal, 1).Value = NomPolice
End Sub

Private Sub SauverGlyphesEtPreparerReconstruction()
    Dim DerniereLigneA As Long
    Dim i As Long
    
    With FeuilleDestination
        ' Trouver la dernière ligne avec des données dans la colonne A
        DerniereLigneA = .Cells(.Rows.count, "A").End(xlUp).row
        
        ' Copier la colonne A vers la colonne C
        .Range("A1:A" & DerniereLigneA).Copy Destination:=.Range("C1:C" & DerniereLigneA)
        
        ' Effacer les données de la cellule A3 à la fin de la colonne A
        ' (Supposons que "glyphes" signifie toutes les données, modifiez selon vos besoins si différent)
        .Range("A3:A" & DerniereLigneA).ClearContents
        
        ' Si vous voulez effacer spécifiquement des glyphes tout en laissant certains caractères/textes
        ' alors utilisez une boucle pour vérifier chaque cellule et effacer selon votre condition.
        ' Par exemple, supposons que nous voulons effacer toutes les cellules contenant "glyph" dans la chaîne :
        For i = 3 To DerniereLigneA
            If .Cells(i, 1).Value <> "" Then
                .Cells(i, 1).ClearContents
            End If
        Next i
        
        ' Ajuster la largeur de la colonne C en fonction du contenu
        .Columns("C:C").AutoFit
    End With
End Sub

' Constantes globales
Const CheminJournal As String = "C:\Fonts\Log_Reconstitution.xlsm"
Const PrefixeUnicodes As String = "U+"
Const CelluleNomPolice As String = "A1"
Const ColonneUnicodes As Integer = 2
Const ColonnesGlyphes As Integer = 1
Const LigneDebut As Integer = 3
Const UnicodeApostrophe As String = "U+0027"
Const UnicodeEspace As String = "U+0020"

' Fonctions utilitaires
Function ObtenirClasseur(ByVal Chemin As String) As Workbook
    Set ObtenirClasseur = Workbooks.Open(Chemin)
End Function

Function ObtenirNomPolice(ByVal Feuille As Worksheet) As String
    ObtenirNomPolice = Feuille.Range(CelluleNomPolice).Value
End Function

Function ObtenirUnicodes(ByVal Feuille As Worksheet, ByVal Ligne As Integer) As String
    ObtenirUnicodes = CStr(Feuille.Cells(Ligne, ColonneUnicodes).Value)
End Function

Function EstCeUneSyntaxeUnicodeCorrecte(ByVal Unicode As String) As Boolean
    EstCeUneSyntaxeUnicodeCorrecte = Unicode Like PrefixeUnicodes & "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]*"
End Function

Function ObtenirValeurUnicode(ByVal Unicode As String) As Variant
    Unicode = Right(Unicode, Len(Unicode) - Len(PrefixeUnicodes))
    ObtenirValeurUnicode = Application.Evaluate("=HEX2DEC(""" & Unicode & """)")
End Function

Function EstCeUneValeurUnicodeCorrecte(ByVal ValeurUnicode As Variant) As Boolean
    EstCeUneValeurUnicodeCorrecte = Not IsError(ValeurUnicode) And ValeurUnicode >= 0 And ValeurUnicode <= &H10FFFF
End Function

Function HEX2DEC(ByVal HexValue As String) As Long
    HEX2DEC = Application.Evaluate("=HEX2DEC(""" & HexValue & """)")
End Function

Function ObtenirGlyphes(ByVal ValeurUnicode As Variant) As String
    ObtenirGlyphes = ChrW(CLng(ValeurUnicode))
End Function

Function EstCeUneGlypheSpeciale(ByVal Glyphe As String) As Boolean
    EstCeUneGlypheSpeciale = (Glyphe = ChrW(HEX2DEC(Mid(UnicodeApostrophe, 3))) Or Glyphe = ChrW(HEX2DEC(Mid(UnicodeEspace, 3))))
End Function

Private Sub DefinirGlyphes(ByVal Feuille As Worksheet, ByVal Ligne As Integer, ByVal Glyphe As String, ByVal NomPolice As String)
    With Feuille.Cells(Ligne, ColonnesGlyphes)
        .Value = Glyphe
        .Font.Name = NomPolice
        .Font.Size = 40
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

Function AjouterErreur(ByVal NombreGlyphesErronees As String, ByVal CelluleUnicode As Range) As String
    AjouterErreur = NombreGlyphesErronees & CelluleUnicode.Address & ", "
End Function

Function FormaterJournalErreurs(ByVal NombreGlyphesErronees As String) As String
    If NombreGlyphesErronees = "" Then
        FormaterJournalErreurs = "0"
    Else
        FormaterJournalErreurs = Left(NombreGlyphesErronees, Len(NombreGlyphesErronees) - 2)  ' Supprimer la virgule et l'espace en fin
    End If
End Function

Function FormaterJournalSpecial(ByVal NombreApostrophes As Integer, ByVal NombreEspaces As Integer) As String
    Dim Total As Integer

    Total = NombreApostrophes + NombreEspaces

    If Total = 0 Then
        FormaterJournalSpecial = "0"
    Else
        FormaterJournalSpecial = "Apostrophes: " & NombreApostrophes & ", Espaces: " & NombreEspaces
    End If
End Function

Private Sub JournaliserResultats(ByVal NomPolice As String, ByVal NombreUnicodes As Integer, ByVal NombreGlyphes As Integer, ByVal NombreGlyphesErronees As String, ByVal GlyphesSpeciales As String)
    Dim ClasseurJournal As Workbook
    Dim FeuilleJournal As Worksheet
    Dim LigneSuivante As Long

    Set ClasseurJournal = ObtenirClasseur(CheminJournal)
    Set FeuilleJournal = ClasseurJournal.Worksheets(1)

    LigneSuivante = FeuilleJournal.Cells(FeuilleJournal.Rows.count, 1).End(xlUp).row + 1

    With FeuilleJournal
        If LigneSuivante = 2 Then
            .Cells(1, 1).Value = "Liste des polices"
            .Cells(1, 2).Value = "Total de codes Unicode trait" & ChrW(233) & "s"
            .Cells(1, 3).Value = "Total de Glyphes reconstitu" & ChrW(233) & "s"
            .Cells(1, 4).Value = "Unicodes non valides"
            .Cells(1, 5).Value = "Glyphes sp" & ChrW(233) & "ciaux"
            .Cells(1, 6).Value = "Approuv" & ChrW(233)
        End If
        .Cells(LigneSuivante, 1).Value = NomPolice
        .Cells(LigneSuivante, 2).Value = NombreUnicodes
        .Cells(LigneSuivante, 3).Value = NombreGlyphes
        .Cells(LigneSuivante, 4).Value = NombreGlyphesErronees
        .Cells(LigneSuivante, 5).Value = GlyphesSpeciales
        .Cells(LigneSuivante, 6).Value = ""
    End With

    ' ClasseurJournal.Close SaveChanges:=True
    ClasseurJournal.Save

    Set FeuilleJournal = Nothing
    Set ClasseurJournal = Nothing
End Sub

Private Sub ReconstituerGlyphes(ByVal Feuille As Worksheet)
    Dim NomPolice As String
    Dim NombreUnicodes As Integer
    Dim NombreGlyphes As Integer
    Dim NombreGlyphesErronees As String
    Dim NombreApostrophes As Integer
    Dim NombreEspaces As Integer
    Dim Ligne As Integer

    NomPolice = ObtenirNomPolice(Feuille)
    Ligne = LigneDebut

    Do While Not IsEmpty(Feuille.Cells(Ligne, ColonneUnicodes))
        Dim Unicode As String
        Dim ValeurUnicode As Variant
        Dim Glyphe As String

        Unicode = ObtenirUnicodes(Feuille, Ligne)

        If Not EstCeUneSyntaxeUnicodeCorrecte(Unicode) Then
            NombreGlyphesErronees = AjouterErreur(NombreGlyphesErronees, Feuille.Cells(Ligne, ColonneUnicodes))
        Else
            ValeurUnicode = ObtenirValeurUnicode(Unicode)

            If Not EstCeUneValeurUnicodeCorrecte(ValeurUnicode) Then
                NombreGlyphesErronees = AjouterErreur(NombreGlyphesErronees, Feuille.Cells(Ligne, ColonneUnicodes))
            Else
                NombreUnicodes = NombreUnicodes + 1
                Glyphe = ObtenirGlyphes(ValeurUnicode)

                Call DefinirGlyphes(Feuille, Ligne, Glyphe, NomPolice)

                NombreGlyphes = NombreGlyphes + 1

                If EstCeUneGlypheSpeciale(Glyphe) Then
                    If Glyphe = ChrW(HEX2DEC(Mid(UnicodeApostrophe, 3))) Then
                        NombreApostrophes = NombreApostrophes + 1
                    Else
                        NombreEspaces = NombreEspaces + 1
                    End If
                End If
            End If
        End If

        Ligne = Ligne + 1
    Loop

    NombreGlyphesErronees = FormaterJournalErreurs(NombreGlyphesErronees)
    GlyphesSpeciales = FormaterJournalSpecial(NombreApostrophes, NombreEspaces)

    Call JournaliserResultats(NomPolice, NombreUnicodes, NombreGlyphes, NombreGlyphesErronees, GlyphesSpeciales)
    MsgBox "La reconstitution des Glyphes est termin" & ChrW(233) & "e. Consultez le journal pour plus de d" & ChrW(233) & "tails.", vbInformation
End Sub

Sub ExecuterReconstitutionGlyphes()
    Call ReconstituerGlyphes(Feuil1)
End Sub

' Fonction pour obtenir la dernière police traitée à partir d'une feuille de journal
Function ObtenirDernierePoliceTraitee(ByRef FeuilleJournal As Worksheet) As String
    Dim DerniereLigneJournal As Long
    DerniereLigneJournal = FeuilleJournal.Cells(FeuilleJournal.Rows.Count, "A").End(xlUp).Row
    
    If DerniereLigneJournal > 1 Then
        ObtenirDernierePoliceTraitee = FeuilleJournal.Cells(DerniereLigneJournal, 1).Value
    Else
        ObtenirDernierePoliceTraitee = ""
    End If
End Function

' Fonction pour obtenir la colonne de départ pour le traitement suivant
Function ObtenirColonneDepartPourTraitement(ByRef FeuilleSource As Worksheet, ByVal DernierePoliceTraitee As String) As Long
    Dim i As Long
    ObtenirColonneDepartPourTraitement = 1
    If DernierePoliceTraitee <> "" Then
        For i = 1 To FeuilleSource.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
            Debug.Print "Vérification de la colonne " & i & " : " & FeuilleSource.Cells(1, i).Value
            If FeuilleSource.Cells(1, i).Value = DernierePoliceTraitee Then
                ObtenirColonneDepartPourTraitement = i + 2
                Debug.Print "Police trouvée dans la colonne " & i & ". Nouvelle colonne de départ : " & ObtenirColonneDepartPourTraitement
                Exit For
            End If
        Next i
    Else
        Debug.Print "Aucune dernière police à traiter."
    End If
End Function

' Fonction pour convertir un numéro de colonne en lettre
Function ColonneEnLettre(Colonne As Integer) As String
    If Colonne > 0 And Colonne <= Columns.Count Then
        ColonneEnLettre = Split(Cells(1, Colonne).Address, "$")(1)
    Else
        ColonneEnLettre = "InvalidColumn"
    End If
End Function

' Procédure pour copier les données de la "FeuilleDestination" vers la "FeuilleSource"
Sub RamenerDonnees(ByRef FeuilleSource As Worksheet, ByRef FeuilleDestination As Worksheet, ByVal ColonneDepart As Long)
    On Error GoTo ErrorHandler
    
    Dim i As Long
    For i = ColonneDepart To ColonneDepart + 1
        ' Copier la colonne
        FeuilleDestination.Columns(i).Copy
        ' Coller la colonne dans la feuille de destination, dans la première colonne libre
        FeuilleSource.Columns(i).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        ' Coloration en jaune
        FeuilleSource.Columns(i).Interior.Color = RGB(255, 255, 0)
        ' Désactiver le mode de copie
        Application.CutCopyMode = False
        Debug.Print "Colonne " & i & " copiée avec succès."
    Next i
    
    Debug.Print "Données copiées avec succès."
    Exit Sub
    
ErrorHandler:
    Debug.Print "Erreur dans RamenerDonnees(): " & Err.Description
End Sub

Private Sub SauvegardeDesClasseurs()
    ClasseurSource.Save
    ClasseurDestination.Save
    ClasseurJournal.Save
End Sub

' Procédure principale
Private Sub CommandButton1_Click()
    ' On Error GoTo ErrorHandler
    
    Call InitialisationDesVariables
    
    ' Désactivez la mise à jour de l'écran et passez en mode de calcul manuel
    ConfigurerApplication False
    
    ' Identification de la dernière police traitée
    Dim DernierePolice As String
    DernierePolice = ObtenirDernierePoliceTraitee(FeuilleJournal)
    
    ' Trouver la colonne de la dernière police traitée dans la source
    Dim DerniereColonne As Long
    DerniereColonne = ObtenirColonneDepartPourTraitement(FeuilleSource, DernierePolice)
    
    ' Vérification qu'il reste des polices à traiter dans la source
    If DerniereColonne <= FeuilleSource.Cells(1, Columns.count).End(xlToLeft).Column Then
        Dim PoliceATraiter As String
        PoliceATraiter = FeuilleSource.Cells(1, DerniereColonne).Value
        
        Debug.Print "Prochaine police à traiter: " & PoliceATraiter
            
        ' Enregistrement de la prochaine police dans le journal
        ' EnregistrerPoliceDansJournal FeuilleJournal, PoliceATraiter
        
        ' Nettoyer la feuille Destination avant de copier les nouvelles données
        NettoyerFeuille FeuilleDestination
        
        ' Copie des colonnes si une police est trouvée
        CopierDonnees FeuilleSource, FeuilleDestination, DerniereColonne
        
        ' Sauvegarde pour vérification visuelle la colonne A en C de Destination
        SauverGlyphesEtPreparerReconstruction
        
        ' Application du script de traitement ReconstituerGlyphes aux données copiées intégrant la journalisation précédemment commentée
        ReconstituerGlyphes FeuilleDestination
        
        ' Ramener les colonnes A et B de Destination vers leur emplacement d'origine dans Source
        RamenerDonnees
                
    Else
        Debug.Print "Toutes les polices ont été traitées."
    End If
    
    ' Sauvegarde des classeurs
    Call SauvegardeDesClasseurs
    
    ' Réactivez la mise à jour de l'écran et passez en mode de calcul automatique
    ConfigurerApplication True
    
    Exit Sub
    
ErrorHandler:
    ' Réactivez la mise à jour de l'écran et passez en mode de calcul automatique
    ConfigurerApplication True
    
    Debug.Print "Une erreur a été rencontrée " & Err.Number & " : " & Err.Description
    ' Possibilité d'ajouter une instruction pour reprendre l'exécution après l'erreur
    ' Resume Next
End Sub