Microsoft 365 Import Donnes issu de fichier CSV

Private Sub UserForm_Initialize()

ImporterDonneesCSV

 With LsV_Import
  With .ColumnHeaders
      .Clear
      .Add , , "N° Question", 60
      .Add , , "Question", 300
      .Add , , "Réponse A", 100
      .Add , , "Réponse B", 100
      .Add , , "Réponse C", 100
      .Add , , "Réponse D", 100
      .Add , , "Niveau", 40, lvwColumnCenter
    End With
    .View = lvwReport 'Affichage en mode Rapport
  End With
  LsV_Import.Gridlines = True 'Affichage d'un quadrillage
  appel
fin:
    Dim i As Integer
   
    ' Parcours de toutes les lignes de la ListView
    For i = 1 To LsV_Import.ListItems.Count
        ' Changer la couleur de la deuxième colonne (index 2)
        'LsV_Import.ListItems(i).ListSubItems(3).ForeColor = RGB(146, 208, 80) ' Modifier vbRed avec la couleur souhaitée
    Next i
End Sub

Sub appel()
Dim i, k
With LsV_Import
 Sheets("Import Theme").Activate
 For i = 1 To Range("A65536").End(xlUp).Row
       
           .ListItems.Add , , Cells(i, 1)
               For k = 2 To 11
                 .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(i, k), , lvwColumnCenter
               Next
         .ListItems(.ListItems.Count).ListSubItems.Add , , i, , lvwColumnCenter
        Next
End With
fin:
End Sub

Sub ImporterDonneesCSV()

    Dim fichier As Variant
    Dim x As Long
    Dim a() As String
    Dim n As Long
    Dim b() As String
    Dim i As Long

    ChDir ThisWorkbook.Path
    fichier = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv")

    If fichier = False Then Exit Sub

    Application.ScreenUpdating = False

    ' Supprimez les données existantes sur la feuille "Import Theme"
    Sheets("Import Theme").Cells.Delete

    Workbooks.OpenText fichier, semicolon:=True, Local:=True
'    ActiveSheet.UsedRange.Copy Sheets("Import Theme").Range("A1")
    ActiveSheet.UsedRange.Copy Feuil2.[A1]
    ActiveWorkbook.Close

    ' Effectuez les remplacements de caractères
    With Sheets("Import Theme").Cells
        '.Replace "Ã ", "à", xlPart
        .Replace "Ã ", "à", xlPart
        .Replace "À", "À"
        .Replace "â", "â"
        .Replace "ç", "ç"
        .Replace "é", "é"
        .Replace "É", "É"
        .Replace "è", "è"
        .Replace "ê", "ê"
        .Replace "î", "î"
        .Replace "ô", "ô"
        .Replace "ü", "ü"
        .Replace "«", "«"
        .Replace "»", "»"
    End With

    ' Ajustez les largeurs des colonnes
    Sheets("Import Theme").Columns.AutoFit

    ' Supprimez les lignes qui ne sont pas en français
    SupprimerLignesNonFR

    ' Assignez des valeurs de niveau
    AssignerNiveauValeurs
 
    Application.ScreenUpdating = True

    MsgBox "Données CSV importées avec succès sur la feuille 'Import Theme'."

End Sub

Sub SupprimerLignesNonFR()
Dim ws As Worksheet
Dim DerrLigne As Long, i As Long

' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("Import theme")

' Trouver la dernière ligne dans la colonne "B"
DerrLigne = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

' Parcourir de la dernière ligne à la première
For i = DerrLigne To 1 Step -1
    ' Vérifier si la valeur de la cellule dans la colonne "B" n'est pas "FR"
    If ws.Cells(i, "B").Value <> "fr" Then
        ' Si ce n'est pas "FR", supprimer la ligne entière
        ws.Rows(i).Delete
    End If
Next i
End Sub

Sub AssignerNiveauValeurs()
Dim ws As Worksheet
Dim DerrLigne As Long
Dim niveau As String
Dim valeur As Integer

' Spécifier la feuille de calcul
Set ws = ThisWorkbook.Sheets("Import Theme")

' Boucler à travers les lignes de la colonne H
For DerrLigne = 1 To ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    ' Récupérer le niveau de compétence dans la colonne H
    niveau = ws.Cells(DerrLigne, "H").Value
 
    ' Assigner la valeur en fonction du niveau
    Select Case niveau
        Case "Débutant"
            valeur = 1
        Case "Confirmé"
            valeur = 2
        Case "Expert"
            valeur = 3
        Case Else
            ' Gérer les cas où le niveau n'est pas spécifié
            ' ou n'est pas l'un des cas attendus
            valeur = 0 ' Ou toute autre valeur que vous voulez assigner pour ces cas
    End Select
 
    ' Assigner la valeur dans une colonne ou ligne spécifique
    ws.Cells(DerrLigne, "H").Value = valeur
 
Next DerrLigne

'Suppression des colonnes "B", "I:J"
Sheets("Import Theme").Range("B:B,I:I,J:J").Delete Shift:=xlToLeft

End Sub

fichier, 650001, semicolon:=True,

Sub ImporterDonneesCSV()

    Dim fichier As Variant
    Dim x As Long
    Dim a() As String
    Dim n As Long
    Dim b() As String
    Dim i As Long

    ChDir ThisWorkbook.Path
    fichier = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv")

    If fichier = False Then Exit Sub

    Application.ScreenUpdating = False

    ' Supprimez les données existantes sur la feuille "Import Theme"
    Sheets("Import Theme").Cells.Delete

 '   Workbooks.OpenText fichier, semicolon:=True, Local:=True
 Workbooks.OpenText fichier, 65001, semicolon:=True, Local:=True
'    ActiveSheet.UsedRange.Copy Sheets("Import Theme").Range("A1")
    ActiveSheet.UsedRange.Copy Feuil2.[A1]
    ActiveWorkbook.Close

'    ' Effectuez les remplacements de caractères
'    With Sheets("Import Theme").Cells
'        '.Replace "Ã ", "à", xlPart
'        .Replace "Ã ", "à", xlPart
'        .Replace "À", "À"
'        .Replace "â", "â"
'        .Replace "ç", "ç"
'        .Replace "é", "é"
'        .Replace "É", "É"
'        .Replace "è", "è"
'        .Replace "ê", "ê"
'        .Replace "î", "î"
'        .Replace "ô", "ô"
'        .Replace "ü", "ü"
'        .Replace "«", "«"
'        .Replace "»", "»"
'    End With

    ' Ajustez les largeurs des colonnes
    Sheets("Import Theme").Columns.AutoFit

    ' Supprimez les lignes qui ne sont pas en français
    SupprimerLignesNonFR

    ' Assignez des valeurs de niveau
    AssignerNiveauValeurs
    
    Application.ScreenUpdating = True

    MsgBox "Données CSV importées avec succès sur la feuille 'Import Theme'."

End Sub

Sub SupprimerLignesNonFR()
Dim ws As Worksheet
Dim DerrLigne As Long, i As Long

' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("Import theme")

' Trouver la dernière ligne dans la colonne "B"
DerrLigne = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1

' Parcourir de la dernière ligne à la première
For i = DerrLigne To 2 Step -1
    ' Vérifier si la valeur de la cellule dans la colonne "B" n'est pas "FR"
    If ws.Cells(i, "B").Value <> "fr" Then
        ' Si ce n'est pas "FR", supprimer la ligne entière
        ws.Rows(i).Delete
    End If
Next i
End Sub

Sub AssignerNiveauValeurs()
Dim ws As Worksheet
Dim DerrLigne As Long
Dim niveau As String
Dim valeur As Integer

' Spécifier la feuille de calcul
Set ws = ThisWorkbook.Sheets("Import Theme")

' Boucler à travers les lignes de la colonne H
For DerrLigne = 1 To ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    ' Récupérer le niveau de compétence dans la colonne H
    niveau = ws.Cells(DerrLigne, "H").Value
    
    ' Assigner la valeur en fonction du niveau
    Select Case niveau
        Case "Débutant"
            valeur = 1
        Case "Confirmé"
            valeur = 2
        Case "Expert"
            valeur = 3
        Case Else
            ' Gérer les cas où le niveau n'est pas spécifié
            ' ou n'est pas l'un des cas attendus
            valeur = 0 ' Ou toute autre valeur que vous voulez assigner pour ces cas
    End Select
    
    ' Assigner la valeur dans une colonne ou ligne spécifique
    ws.Cells(DerrLigne, "H").Value = valeur ' Par exemple, colonne I
    
Next DerrLigne

With ws
'Suppression des colonnes "B", "I:J"
.Range("B:B,I:I,J:J").Delete Shift:=xlToLeft

'Ajout des entêtes de colonnes
.Range("A1:K1").Value = Array("N° Questions", "Questions", "Réponse A", "Réponse B", "Réponse C", "Réponse D", "Niveau", "Catégorie", "Theme", "N° Theme", "Difficulté")
End With

End Sub

Sub ReorganiserColonnes()

' Déclarer les variables
Dim ws As Worksheet
Dim DerrLigne As Long

' Spécifier la feuille de calcul
Set ws = ThisWorkbook.Sheets("Import Theme") ' Remplacez "Nom_de_votre_feuille" par le nom de votre feuille

' Trouver la dernière ligne avec des données dans la colonne A
DerrLigne = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

' Déplacer les colonnes
With ws
    .Columns("J:J").Cut
    .Columns("A:A").Insert Shift:=xlToRight
    .Columns("J:J").Cut
    .Columns("C:C").Insert Shift:=xlToRight
    .Columns("I:I").Cut
    .Columns("D:D").Insert Shift:=xlToRight
    
    Application.CutCopyMode = False
End With

Sub PreRemplirColonnes_AC()
    Dim ws As Worksheet
    Dim DerrLigne As Long
    Dim i As Long

    ' Spécifie la feuille de calcul à utiliser
    Set ws = ThisWorkbook.Sheets("Import Theme")

    ' Trouve la dernière ligne de la colonne A
    DerrLigne = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Parcourt toutes les lignes de la colonne A à partir de la ligne 2 jusqu'à la dernière ligne
    For i = 2 To DerrLigne
        ' Remplit la cellule de la colonne A avec la valeur "A définir"
        With ws
            .Cells(i, "A").Value = "A définir"
            .Cells(i, "C").Value = "A définir"
        End With
    Next i
End Sub

' Ajout :   ----->>>>   .TextFilePlatform = 65001
' J'ai ajouté : Le paramètre .TextFilePlatform = 65001 spécifie le code de page Windows (ou code de caractère)
' à utiliser lors de l'importation du fichier CSV.
' Le code 65001 correspond à l'encodage UTF-8, qui est un encodage de caractères multioctets pouvant
' représenter l'ensemble des caractères Unicode.

' Lorsque vous importez un fichier CSV dans Excel, Excel doit interpréter les caractères du fichier en
' fonction de l'encodage spécifié pour pouvoir les afficher correctement. Par défaut, Excel utilise souvent
' l'encodage du système d'exploitation, mais parfois cela peut ne pas fonctionner correctement pour tous les
' fichiers, en particulier ceux avec des caractères spéciaux ou des caractères provenant de différentes langues.

' En spécifiant .TextFilePlatform = 65001, vous indiquez explicitement à Excel d'utiliser l'encodage UTF-8 pour
' interpréter les caractères lors de l'importation du fichier CSV. Cela garantit que les caractères spéciaux et les
' caractères provenant de différentes langues sont correctement interprétés et affichés dans Excel.

' Maintenant les caractères spéciaux devraient être importés et affichés correctement dans votre feuille Excel.

Sub ImportCSVWithDynamicColumns()
    Dim ws As Worksheet
    Dim filePath As String
    Dim qt As QueryTable
    Dim firstLine As String
    Dim colCount As Integer
    Dim colDataTypes() As Integer
    Dim i As Integer
    Dim FSO As Object
    Dim myFile As Object
 
    filePath = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv")
    ' Définir le chemin du fichier CSV
    'filePath = "C:\chemin\vers\le\fichier.csv"
 
    ' Vérifier si le fichier existe
    If Dir(filePath) = "" Then
        MsgBox "Le fichier n'existe pas : " & filePath, vbExclamation
        Exit Sub
    End If
 
    ' Lire la première ligne du fichier CSV
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFile = FSO.OpenTextFile(filePath, 1)
    If Not myFile.AtEndOfStream Then
        firstLine = myFile.ReadLine
    End If
    myFile.Close
 
    ' Afficher la première ligne pour vérification
    'MsgBox "Première ligne du fichier CSV: " & firstLine
 
    ' Compter le nombre de colonnes en comptant les délimiteurs ;
    colCount = UBound(Split(firstLine, ";")) + 1
 
    ' Créer dynamiquement le tableau TextFileColumnDataTypes
    ReDim colDataTypes(1 To colCount)
    For i = 1 To colCount
        colDataTypes(i) = 1 ' Importer toutes les colonnes comme texte
    Next i
 
    ' Ajouter une nouvelle feuille ou utiliser la feuille active
    Set ws = ThisWorkbook.Sheets.Add ' Vous pouvez aussi utiliser ThisWorkbook.Sheets("NomDeLaFeuille")
 
    ' Créer une QueryTable pour importer les données du fichier CSV
    On Error GoTo ErrHandler
    Set qt = ws.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=ws.Range("A1"))
 
    ' Configurer les paramètres de la QueryTable
    With qt
        .TextFilePlatform = 65001
        .TextFileParseType = xlDelimited
        '.TextFileCommaDelimiter = False
        .TextFileSemicolonDelimiter = True ' Définir le délimiteur comme un point-virgule
        '.TextFileConsecutiveDelimiter = False
        '.TextFileTabDelimiter = False
        '.TextFileSpaceDelimiter = False
        '.TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = colDataTypes ' Utiliser le tableau dynamique
        .Refresh BackgroundQuery:=False
        .Parent.Names(.Name).Delete       ' Supprimer le nom défini créé par Excel
        .Delete ' Supprimer la QueryTable
    End With

    ' Nettoyer
    Set qt = Nothing
    Set ws = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Erreur lors de l'importation du fichier CSV : " & Err.Description, vbCritical
    If Not qt Is Nothing Then
        qt.Delete
        Set qt = Nothing
    End If
    If Not ws Is Nothing Then
        ws.Delete
        Set ws = Nothing
    End If
End Sub

Sub ImportCSVWithDynamicColumns()
    Dim ws As Worksheet
    Dim filePaths As Variant
    Dim qt As QueryTable
    Dim firstLine As String
    Dim colCount As Integer
    Dim colDataTypes() As Integer
    Dim i As Integer
    Dim FSO As Object
    Dim myFile As Object
    Dim lastRow As Long
    Dim filePath As Variant

    ' Demander à l'utilisateur de sélectionner les fichiers CSV (multiselection)
    filePaths = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv", , "Sélectionnez les fichiers CSV", , True)
   
    ' Vérifier si l'utilisateur a annulé la sélection
    If IsArray(filePaths) = False Then Exit Sub

    ' Ajouter une nouvelle feuille ou utiliser la feuille active
    Set ws = ThisWorkbook.Sheets.Add

    ' Initialiser FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Boucler sur chaque fichier sélectionné
    For Each filePath In filePaths
        ' Vérifier si le fichier existe
        If Dir(filePath) = "" Then
            MsgBox "Le fichier n'existe pas : " & filePath, vbExclamation
            Exit Sub
        End If

        ' Lire la première ligne du fichier CSV
        Set myFile = FSO.OpenTextFile(filePath, 1)
        If Not myFile.AtEndOfStream Then
            firstLine = myFile.ReadLine
        End If
        myFile.Close

        ' Compter le nombre de colonnes en comptant les délimiteurs ;
        colCount = UBound(Split(firstLine, ";")) + 1

        ' Créer dynamiquement le tableau TextFileColumnDataTypes
        ReDim colDataTypes(1 To colCount)
        For i = 1 To colCount
            colDataTypes(i) = 1 ' Importer toutes les colonnes comme texte
        Next i

        ' Trouver la dernière ligne utilisée
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        If lastRow = 1 And ws.Cells(1, 1).Value = "" Then
            lastRow = 0 ' Si la feuille est vide, commencer à la première ligne
        End If

        ' Créer une QueryTable pour importer les données du fichier CSV
        On Error GoTo ErrHandler
        Set qt = ws.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=ws.Cells(lastRow + 1, 1))

        ' Configurer les paramètres de la QueryTable
        With qt
            .TextFilePlatform = 65001
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True ' Définir le délimiteur comme un point-virgule
            .TextFileColumnDataTypes = colDataTypes ' Utiliser le tableau dynamique
            .Refresh BackgroundQuery:=False
            .Parent.Names(.Name).Delete ' Supprimer le nom défini créé par Excel
            .Delete ' Supprimer la QueryTable
        End With
    Next filePath

    ' Nettoyer
    Set qt = Nothing
    Set ws = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Erreur lors de l'importation du fichier CSV : " & Err.Description, vbCritical
    If Not qt Is Nothing Then
        qt.Delete
        Set qt = Nothing
    End If
    If Not ws Is Nothing Then
        ws.Delete
        Set ws = Nothing
    End If
End Sub

Sub IMPORTDATA()
Dim fichier As Variant, F As Worksheet, lig&, n
ChDir ThisWorkbook.Path
fichier = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv", MultiSelect:=True)
If Not IsArray(fichier) Then Exit Sub
Set F = Sheets("Feuil1")
Application.ScreenUpdating = False
F.Cells.Delete 'RAZ
lig = 9
For n = 1 To UBound(fichier)
    Workbooks.OpenText fichier(n), 65001, DataType:=xlDelimited, Semicolon:=True, Comma:=True, Space:=False, Local:=True
    ActiveSheet.UsedRange.Copy F.Cells(lig, 1)
    ActiveWorkbook.Close
    lig = F.UsedRange.Row + F.UsedRange.Rows.Count
Next
F.ListObjects.Add xlSrcRange, F.UsedRange, , xlYes 'crée le tableau structuré
F.Columns.AutoFit 'ajustement largeurs
Application.ScreenUpdating = True
MsgBox n - 1 & " fichier(s) CSV importé(s)"
End Sub