Hello à tous,

J'ai un problème avec une macro, notre stagiaire en charge de ce VBA n'est plus venu travailler du jour au lendemain. N'ayant personne en interne maitrisant le VBA je m'en donc remet à vous.

Tout fonctionne (import des données, export dans d'autres fichiers CSV mis en forme) hormis une chose, l'encodage des caractères est faux et les caractères accentués ne sont pas importés correctement. Il faut changer quelque chose dans l'import à mon avis.

Est-ce qu'un pro arriverait à me régler ça? Je lui en serait très reconnaissant

Voici le code en charge de l'import des données:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
Sub ListerFichiers()
 
    Dim Rep As String, Fichier As String
    Dim suffix As String
    Dim RepExport As String
    Dim WS As Worksheet
 
    Dim nbCSV As Integer: nbCSV = 2
    Dim Ligne As String
    Dim LeTableau()
    Dim TableauFin()
    Dim i As Long: i = 0
    Dim n As Long: n = 0
    Dim j As Long
    Dim NoCol As Long
     Dim iTemp As Long: iTemp = 0
 
    'Définir le chemin du dossier source ***************************
    'Définir le chemin du dossier ou se trouve le fichier en cours**
    Rep = ThisWorkbook.Path
    'Pointer sur le chemin du dossier ou se trouve les fichiers csv*
    Rep = Rep & "\Source\"
    'Mettre les noms des CSV dans une variable *********************
    Fichier = Dir(Rep)
 
    suffix = Left(Fichier, InStr(Fichier, "-") - 1)
    Application.ScreenUpdating = False
 
    For Each WS In Worksheets
        n = n + 1
        If WS.Name <> "Sources" Then
            WS.Name = suffix
            If WS.Name = suffix Then
            On Error Resume Next
            On Error GoTo 0
                WS.[_CodeName] = suffix
            End If
 
        End If
    Next WS
    n = 0
    'MsgBox suffix
    'Boucle pour lister les fichiers csv dans la feuille Source*****
    Fichier = Rep & Fichier
    Sources.Range("A" & nbCSV).Value = Fichier
 
    '**********Importer chaque fichier CSV dans Source ***********
    Open Fichier For Input As #1
    While Not EOF(1)
        Input #1, Ligne
        i = i + 1
        ReDim Preserve LeTableau(i)
        LeTableau(i) = Split(Ligne, ";")
    Wend
    '**********Transcrire le contenu dans la feuille Excel***********
    Sheets(suffix).Activate
    Sheets(suffix).Range("B2").Value = UCase(suffix)
    For j = 1 To i - 1 'Pour chaque ligne
         For NoCol = 0 To 4 'Pour chaque colonne
              ActiveSheet.Cells(j + 5, NoCol + 1).Value = LeTableau(j + 1)(NoCol)
         Next
        '**********Encadrer les cellules et mettre en rouge le texte *****
        ActiveSheet.Range("A" & j + 5 & ":B" & j + 5).Select
        encadrerCellules 'Encadrer les cellules
 
        '**********Mettre en rouge le texte *****
        ActiveSheet.Range("C" & j + 5).Select
        ActiveSheet.Range("C" & j + 5).Font.Color = vbRed 'Mettre en rouge le texte
        encadrerCellules
        ActiveSheet.Range("D" & j + 5).Select
        ActiveSheet.Range("D" & j + 5).Font.Color = vbRed
        encadrerCellules
        ActiveSheet.Range("E" & j + 5).Select
        ActiveSheet.Range("E" & j + 5).Font.Color = vbRed
        encadrerCellules
        ActiveSheet.Range("F" & j + 5).Select
        ActiveSheet.Range("F" & j + 5).Font.Color = vbRed
        encadrerCellules
 
    Next
    Close #1
 
    RepExport = ActiveWorkbook.Path & "\Final\"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=RepExport & _
    suffix & "-UserAccounts.xlsx"
    ActiveWorkbook.Close True
 
    Fichier = Dir
'    nbCSV = nbCSV + 1
    Application.ScreenUpdating = True
    'MsgBox "Exportation terminé"
End Sub