import fichier (.txt) /probème avec caractères spéciaux

**flouo** · 17/03/2014, 11h46

Bonjour,

J'utilise la méthode suivante pour importer sur une feuille de calcul le contenu d'un fichier texte.
Tout marche mis à part lorsque je choisi des fichiers (.txt) contenant des accents et des caractères spéciaux.

Par exemple un "é" est modifié en "Ã©".. je ne vois pas d'où ça peut venir, surtout que lorsque je copie et colle "à la main" ce même contenu dans une feuille excel les accents sont reconnus.

Quelqu'un aurait une idée pour résoudre ce problème? Merci

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
 
Sub Tst() 
Dim Fichier As Variant 
    ChDir /Path\
    Fichier = Application.GetOpenFilename("Text Files (*.txt), *.txt" ) 
    If Fichier <> False Then 
        Lire Fichier 
    End If 
End Sub 
 
Function Lire(ByVal NomFichier As String) 
Dim Chaine As String 
Dim Ar() As String 
Dim i As Long 
Dim iRow As Long, iCol As Long 
Dim NumFichier As Integer 
Dim Separateur  As String * 1 
 
    '  Séparateur Tabulation 
    Separateur = Chr(9) 
 
    Cells.Clear 
    NumFichier = FreeFile 
    iRow = 1 
 
    Open NomFichier For Input As #NumFichier 
        Do While Not EOF(NumFichier) 
            iCol = 1 
            Line Input #NumFichier, Chaine 
            Ar = Split(Chaine, Separateur) 
            For i = LBound(Ar) To UBound(Ar) 
                Cells(iRow, iCol) = Ar(i) 
                iCol = iCol + 1 
            Next 
            iRow = iRow + 1 
        Loop 
    Close #NumFichier 
End Function

**Marc-L** · 17/03/2014, 12h06

Bonjour,

le fichier texte n'est tout simplement pas enregistré au bon format !
Voir comment le fichier est créé, cela sent l'UTF8 au lieu de Windows …

Sinon faire une recherche sur UTF8 afin d'effectuer une transposition de caractères …

Invité · 17/03/2014, 12h37

j’avais fait ce code(à partir d'une source web) pour un autre candidat du forum,il permet au choix d'encoder ou décoder l'UTF :

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Function Lire(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur  As String * 1
 
    '  Séparateur Tabulation
    Separateur = Chr(9)
 
    Cells.Clear
    NumFichier = FreeFile
    iRow = 1
 
    Open NomFichier For Input As #NumFichier
        Do While Not EOF(NumFichier)
            iCol = 1
            Line Input #NumFichier, Chaine
           Chaine = Decode_UTF8(Chaine)
            Ar = Split(Chaine, Separateur)
            For i = LBound(Ar) To UBound(Ar)
                Cells(iRow, iCol) = Ar(i)
                iCol = iCol + 1
            Next
            iRow = iRow + 1
        Loop
    Close #NumFichier
End Function
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
 
    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext
 
    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext
 
    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If
 
    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop
 
    Decode_UTF8 = unitext
End Function

**Marc-L** · 17/03/2014, 12h47

Ou bien encore via ADODB.Stream …

**flouo** · 17/03/2014, 12h58

Je vous remercie tous les deux pour vos réponses, et bien sûr vous aviez raison.. c'était un fichier UNICODE.

Rdurupt, ta solution de décodage de l'UTF fonctionne très bien dans mon cas,parfait!

Bonne journée

import fichier (.txt) /probème avec caractères spéciaux [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager